From a052dfb20f3d07e912c1db61e2d79757c7de2b48 Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Sun, 23 Nov 2025 00:24:43 +0100 Subject: [PATCH] AST testing --- ASTPlayground/ASTPlayground.delphilsp.json | 2 +- ASTPlayground/MainForm.pas | 5 +- ASTPlayground/Myc.Fmx.AstEditor.Node.pas | 12 +- ASTPlayground/Myc.Fmx.AstEditor.Text.pas | 4 +- Src/AST/Myc.Ast.Compiler.Binder.Upvalues.pas | 2 +- Src/AST/Myc.Ast.Compiler.Binder.pas | 11 +- Src/AST/Myc.Ast.Compiler.Macros.pas | 76 ++- Src/AST/Myc.Ast.Compiler.TypeChecker.pas | 6 +- Src/AST/Myc.Ast.Debugger.pas | 4 +- Src/AST/Myc.Ast.Dumper.pas | 4 +- Src/AST/Myc.Ast.Environment.pas | 62 +- Src/AST/Myc.Ast.Evaluator.pas | 15 +- Src/AST/Myc.Ast.JSON.pas | 4 +- Src/AST/Myc.Ast.Nodes.pas | 8 +- Src/AST/Myc.Ast.Script.pas | 23 +- Src/AST/Myc.Ast.Visitor.pas | 21 +- Src/AST/Myc.Ast.pas | 54 +- Src/Data/TestDataTypes.JSON.pas | 411 ----------- Src/Data/TestDataTypes.pas | 676 ------------------- Test/AST/Test.Myc.Ast.Compiler.Macros.pas | 250 +++++++ Test/AST/Test.Myc.Ast.Script.pas | 382 +++++++++++ Test/MycTests.dpr | 10 +- Test/MycTests.dproj | 10 +- 23 files changed, 792 insertions(+), 1260 deletions(-) delete mode 100644 Src/Data/TestDataTypes.JSON.pas delete mode 100644 Src/Data/TestDataTypes.pas create mode 100644 Test/AST/Test.Myc.Ast.Compiler.Macros.pas create mode 100644 Test/AST/Test.Myc.Ast.Script.pas diff --git a/ASTPlayground/ASTPlayground.delphilsp.json b/ASTPlayground/ASTPlayground.delphilsp.json index e6957cc..87f4d9f 100644 --- a/ASTPlayground/ASTPlayground.delphilsp.json +++ b/ASTPlayground/ASTPlayground.delphilsp.json @@ -1 +1 @@ -{ "settings": { "project": "file:///T%3A/Myc/ASTPlayground/ASTPlayground.dpr", "dllname": "dcc64370.dll", "dccOptions": "-$O- -$W+ --inline:off -$R+ -$Q+ --no-config -Q -TX.exe -AGenerics.Collections=System.Generics.Collections;Generics.Defaults=System.Generics.Defaults;WinTypes=Winapi.Windows;WinProcs=Winapi.Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE -DDEBUG;;FRAMEWORK_FMX -E.\\Win64\\Debug -I\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\debug\\DE\";\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\debug\";\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\release\\DE\";T:\\Myc\\Src\\Data;T:\\Myc\\Src\\AST;T:\\Myc\\Src;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\release\";C:\\Users\\Brummel\\Documents\\Embarcadero\\Studio\\37.0\\Imports\\Win64;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\Imports\";C:\\Users\\Public\\Documents\\Embarcadero\\Studio\\37.0\\Dcp\\Win64;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\include\";S:\\sc_famos_src\\svn_vcl\\Virtual-TreeView\\Source;S:\\sc_famos_src\\svn_vcl\\cpxedits;S:\\sc_famos_src\\svn_vcl\\dzChart;S:\\sc_famos_src\\svn_vcl\\eaeditor;S:\\sc_famos_src\\svn_vcl\\FamosEvents;S:\\sc_famos_src\\svn_vcl\\HTML_Viewer\\source;S:\\sc_famos_src\\svn_vcl\\Myc_ChartEdit;S:\\sc_famos_src\\svn_vcl\\Myc_HemiDrag;S:\\sc_famos_src\\svn_vcl\\Myc_SplitControl;S:\\sc_famos_src\\svn_vcl\\plotter;S:\\sc_famos_src\\svn_vcl\\SimpleIPC;S:\\sc_famos_src\\svn_vcl\\SynEdit-master\\Source;S:\\sc_famos_src\\svn_vcl\\ValEdits;S:\\sc_famos_src\\svn_vcl\\ZipMaster;S:\\sc_famos_src\\svn_common\\Myc_VecMath;\"C:\\Program Files (x86)\\DevExpress VCL\\Library\\RS28\\Win64\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressCore Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressCommon Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressGDI+ Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressLibrary\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\XP Theme Manager\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressLayout Control\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressPageControl\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressEditors Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressDocking Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressBars\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressOfficeCore Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressMemData\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressDataController\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressNavBar\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressSkins Library\\Sources\";S:\\3rdParty\\FastMM5;C:\\Users\\Brummel\\AppData\\Local\\Programs\\TestInsight\\Source;T:\\Myc\\Src;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\source\\DUnitX\" -LEC:\\Users\\Public\\Documents\\Embarcadero\\Studio\\37.0\\Bpl\\Win64 -LNC:\\Users\\Public\\Documents\\Embarcadero\\Studio\\37.0\\Dcp\\Win64 -NU.\\Win64\\Debug -NSWinapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;System;Xml;Data;Datasnap;Web;Soap; -OT:\\Myc\\Src\\Data;T:\\Myc\\Src\\AST;T:\\Myc\\Src;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\release\";C:\\Users\\Brummel\\Documents\\Embarcadero\\Studio\\37.0\\Imports\\Win64;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\Imports\";C:\\Users\\Public\\Documents\\Embarcadero\\Studio\\37.0\\Dcp\\Win64;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\include\";S:\\sc_famos_src\\svn_vcl\\Virtual-TreeView\\Source;S:\\sc_famos_src\\svn_vcl\\cpxedits;S:\\sc_famos_src\\svn_vcl\\dzChart;S:\\sc_famos_src\\svn_vcl\\eaeditor;S:\\sc_famos_src\\svn_vcl\\FamosEvents;S:\\sc_famos_src\\svn_vcl\\HTML_Viewer\\source;S:\\sc_famos_src\\svn_vcl\\Myc_ChartEdit;S:\\sc_famos_src\\svn_vcl\\Myc_HemiDrag;S:\\sc_famos_src\\svn_vcl\\Myc_SplitControl;S:\\sc_famos_src\\svn_vcl\\plotter;S:\\sc_famos_src\\svn_vcl\\SimpleIPC;S:\\sc_famos_src\\svn_vcl\\SynEdit-master\\Source;S:\\sc_famos_src\\svn_vcl\\ValEdits;S:\\sc_famos_src\\svn_vcl\\ZipMaster;S:\\sc_famos_src\\svn_common\\Myc_VecMath;\"C:\\Program Files (x86)\\DevExpress VCL\\Library\\RS28\\Win64\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressCore Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressCommon Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressGDI+ Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressLibrary\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\XP Theme Manager\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressLayout Control\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressPageControl\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressEditors Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressDocking Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressBars\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressOfficeCore Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressMemData\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressDataController\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressNavBar\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressSkins Library\\Sources\";S:\\3rdParty\\FastMM5;C:\\Users\\Brummel\\AppData\\Local\\Programs\\TestInsight\\Source;T:\\Myc\\Src;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\source\\DUnitX\" -R\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\release\\DE\";T:\\Myc\\Src\\Data;T:\\Myc\\Src\\AST;T:\\Myc\\Src;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\release\";C:\\Users\\Brummel\\Documents\\Embarcadero\\Studio\\37.0\\Imports\\Win64;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\Imports\";C:\\Users\\Public\\Documents\\Embarcadero\\Studio\\37.0\\Dcp\\Win64;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\include\";S:\\sc_famos_src\\svn_vcl\\Virtual-TreeView\\Source;S:\\sc_famos_src\\svn_vcl\\cpxedits;S:\\sc_famos_src\\svn_vcl\\dzChart;S:\\sc_famos_src\\svn_vcl\\eaeditor;S:\\sc_famos_src\\svn_vcl\\FamosEvents;S:\\sc_famos_src\\svn_vcl\\HTML_Viewer\\source;S:\\sc_famos_src\\svn_vcl\\Myc_ChartEdit;S:\\sc_famos_src\\svn_vcl\\Myc_HemiDrag;S:\\sc_famos_src\\svn_vcl\\Myc_SplitControl;S:\\sc_famos_src\\svn_vcl\\plotter;S:\\sc_famos_src\\svn_vcl\\SimpleIPC;S:\\sc_famos_src\\svn_vcl\\SynEdit-master\\Source;S:\\sc_famos_src\\svn_vcl\\ValEdits;S:\\sc_famos_src\\svn_vcl\\ZipMaster;S:\\sc_famos_src\\svn_common\\Myc_VecMath;\"C:\\Program Files (x86)\\DevExpress VCL\\Library\\RS28\\Win64\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressCore Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressCommon Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressGDI+ Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressLibrary\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\XP Theme Manager\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressLayout Control\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressPageControl\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressEditors Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressDocking Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressBars\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressOfficeCore Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressMemData\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressDataController\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressNavBar\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressSkins Library\\Sources\";S:\\3rdParty\\FastMM5;C:\\Users\\Brummel\\AppData\\Local\\Programs\\TestInsight\\Source;T:\\Myc\\Src;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\source\\DUnitX\" -U\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\debug\\DE\";\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\debug\";\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\release\\DE\";T:\\Myc\\Src\\Data;T:\\Myc\\Src\\AST;T:\\Myc\\Src;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\release\";C:\\Users\\Brummel\\Documents\\Embarcadero\\Studio\\37.0\\Imports\\Win64;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\Imports\";C:\\Users\\Public\\Documents\\Embarcadero\\Studio\\37.0\\Dcp\\Win64;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\include\";S:\\sc_famos_src\\svn_vcl\\Virtual-TreeView\\Source;S:\\sc_famos_src\\svn_vcl\\cpxedits;S:\\sc_famos_src\\svn_vcl\\dzChart;S:\\sc_famos_src\\svn_vcl\\eaeditor;S:\\sc_famos_src\\svn_vcl\\FamosEvents;S:\\sc_famos_src\\svn_vcl\\HTML_Viewer\\source;S:\\sc_famos_src\\svn_vcl\\Myc_ChartEdit;S:\\sc_famos_src\\svn_vcl\\Myc_HemiDrag;S:\\sc_famos_src\\svn_vcl\\Myc_SplitControl;S:\\sc_famos_src\\svn_vcl\\plotter;S:\\sc_famos_src\\svn_vcl\\SimpleIPC;S:\\sc_famos_src\\svn_vcl\\SynEdit-master\\Source;S:\\sc_famos_src\\svn_vcl\\ValEdits;S:\\sc_famos_src\\svn_vcl\\ZipMaster;S:\\sc_famos_src\\svn_common\\Myc_VecMath;\"C:\\Program Files (x86)\\DevExpress VCL\\Library\\RS28\\Win64\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressCore Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressCommon Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressGDI+ Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressLibrary\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\XP Theme Manager\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressLayout Control\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressPageControl\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressEditors Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressDocking Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressBars\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressOfficeCore Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressMemData\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressDataController\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressNavBar\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressSkins Library\\Sources\";S:\\3rdParty\\FastMM5;C:\\Users\\Brummel\\AppData\\Local\\Programs\\TestInsight\\Source;T:\\Myc\\Src;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\source\\DUnitX\" -V -VN -VR -NBC:\\Users\\Public\\Documents\\Embarcadero\\Studio\\37.0\\Dcp\\Win64 -NHC:\\Users\\Public\\Documents\\Embarcadero\\Studio\\37.0\\hpp\\Win64 -NO.\\Win64\\Debug -LU" , "projectFiles":[ { "name": "MainForm", "file": "file:///T%3A/Myc/ASTPlayground/MainForm.pas" }, { "name": "Myc.Ast.Nodes", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Nodes.pas" }, { "name": "Myc.Ast.Scope", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Scope.pas" }, { "name": "Myc.Data.Value", "file": "file:///T%3A/Myc/ASTPlayground/Myc.Data.Value.pas" }, { "name": "Myc.Ast.Visitor", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Visitor.pas" }, { "name": "Myc.Ast.RTL", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.RTL.pas" }, { "name": "Myc.Ast.Dumper", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Dumper.pas" }, { "name": "Myc.Ast.RTL.Core", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.RTL.Core.pas" }, { "name": "Myc.Fmx.AstEditor.Node", "file": "file:///T%3A/Myc/ASTPlayground/Myc.Fmx.AstEditor.Node.pas" }, { "name": "Myc.Fmx.AstEditor.Workspace", "file": "file:///T%3A/Myc/ASTPlayground/Myc.Fmx.AstEditor.Workspace.pas" }, { "name": "Myc.Fmx.AstEditor.Text", "file": "file:///T%3A/Myc/ASTPlayground/Myc.Fmx.AstEditor.Text.pas" }, { "name": "Myc.Utils", "file": "file:///T%3A/Myc/Src/Myc.Utils.pas" }, { "name": "Myc.Ast.Script", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Script.pas" }, { "name": "Myc.Ast.Types", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Types.pas" }, { "name": "Myc.Data.Keyword", "file": "file:///T%3A/Myc/Src/Data/Myc.Data.Keyword.pas" }, { "name": "Myc.Ast.Compiler.TCO", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Compiler.TCO.pas" }, { "name": "Myc.Ast.Compiler.Binder", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Compiler.Binder.pas" }, { "name": "Myc.Ast.Compiler.Lowering", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Compiler.Lowering.pas" }, { "name": "Myc.Ast.Compiler.TypeChecker", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Compiler.TypeChecker.pas" }, { "name": "Myc.Ast.Compiler.Macros", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Compiler.Macros.pas" }, { "name": "Myc.Ast.Compiler.Specializer", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Compiler.Specializer.pas" }, { "name": "Myc.Ast.Environment", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Environment.pas" }, { "name": "Myc.Ast.Debugger", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Debugger.pas" }, { "name": "Myc.Ast.Analysis.Purity", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Analysis.Purity.pas" } ] , "includeDCUsInUsesCompletion": true, "enableKeyWordCompletion": false, "browsingPaths": [ "file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/OCX/Servers","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/SOURCE/VCL","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/rtl/common","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/SOURCE/RTL/SYS","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/rtl/win","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/rtl/win/winrt","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/ToolsAPI","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/SOURCE/IBX","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/Internet","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/SOURCE/PROPERTY%20EDITORS","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/soap","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/SOURCE/XML","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/Indy10/Core","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/Indy10/System","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/Indy10/Protocols","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/fmx","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/databinding/components","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/databinding/engine","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/databinding/graph","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/ado","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/cloud","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/datasnap","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/dbx","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/dsnap","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/vclctrls","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/datasnap/connectors","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/datasnap/proxygen","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DataExplorer","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnit/Contrib/DUnitWizard/Source/Common","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnit/Contrib/DUnitWizard/Source/Common/dunit","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnit/Contrib/DUnitWizard/Source/DelphiExperts/Common","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnit/Contrib/DUnitWizard/Source/DelphiExperts/DUnitProject","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnit/Contrib/DUnitWizard/Source/DelphiExperts/DUnitProject/dunit","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnit/src","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnit/tests","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/Experts","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/indy/abstraction","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/indy/implementation","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/indyimpl","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/Property%20Editors/Indy10","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/soap/wsdlimporter","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/Visualizers","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnit/Contrib/XMLReporting","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnit/Contrib/XPGen","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/rest","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/firedac","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/tethering","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnitX","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/ems","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/rtl/net","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/FlatBox2D","file:///C%3A/Users/Public/Documents/Embarcadero/Studio/37.0/Dcp/%25PLATFORM%25","file:///%25TP%25/runtime/vcl","file:///S%3A/sc_famos_src/svn_vcl/cpxedits","file:///S%3A/sc_famos_src/svn_vcl/dzChart","file:///S%3A/sc_famos_src/svn_vcl/eaeditor","file:///S%3A/sc_famos_src/svn_vcl/FamosEvents","file:///S%3A/sc_famos_src/svn_vcl/HTML_Viewer/source","file:///S%3A/sc_famos_src/svn_vcl/Myc_ChartEdit","file:///S%3A/sc_famos_src/svn_vcl/Myc_HemiDrag","file:///S%3A/sc_famos_src/svn_vcl/Myc_SplitControl","file:///S%3A/sc_famos_src/svn_vcl/NiceChart","file:///S%3A/sc_famos_src/svn_vcl/plotter","file:///S%3A/sc_famos_src/svn_vcl/SimpleIPC","file:///S%3A/sc_famos_src/svn_vcl/SynEdit-master/Source","file:///S%3A/sc_famos_src/svn_vcl/ValEdits","file:///S%3A/sc_famos_src/svn_vcl/ZipMaster","file:///S%3A/sc_famos_src/svn_vcl/ZipMaster/zlib","file:///S%3A/sc_famos_src/svn_vcl/ZipMaster/zlib/win32","file:///S%3A/sc_famos_src/svn_vcl/Virtual-TreeView/Source","file:///S%3A/sc_famos_src/svn_common/caHelpSys","file:///S%3A/sc_famos_src/svn_common/Misc","file:///S%3A/sc_famos_src/svn_common/Myc_VecMath","file:///S%3A/sc_famos_src/svn_common/PascalScript/source","file:///S%3A/sc_famos_src/svn_common/TreeBase","file:///S%3A/sc_famos_src/svn_common/TreeBase/Medien","file:///S%3A/3rdParty/spring4d/Source","file:///S%3A/3rdParty/spring4d/Source/Base","file:///S%3A/3rdParty/spring4d/Source/Base/Collections","file:///S%3A/3rdParty/spring4d/Source/Base/Logging","file:///S%3A/3rdParty/spring4d/Source/Base/Patches","file:///S%3A/3rdParty/spring4d/Source/Core/Container","file:///S%3A/3rdParty/spring4d/Source/Core/Interception","file:///S%3A/3rdParty/spring4d/Source/Core/Logging","file:///S%3A/3rdParty/spring4d/Source/Core/Mocking","file:///S%3A/3rdParty/spring4d/Source/Core/Services","file:///S%3A/3rdParty/spring4d/Source/Extensions/Cryptography","file:///S%3A/3rdParty/spring4d/Source/Extensions/Utils","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressCore%20Library/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressCommon%20Library/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressGDI%2B%20Library/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressLibrary/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/XP%20Theme%20Manager/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressLayout%20Control/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressPageControl/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressEditors%20Library/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressDocking%20Library/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressBars/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressOfficeCore%20Library/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressMemData/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressDataController/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressNavBar/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressSkins%20Library/Sources","file:///T%3A/Myc/Src","file:///T%3A/Myc/Src/Data","file:///T%3A/Myc/Src/AST" ] , "CommonAppData": "file:///C%3A/Users/Brummel/AppData/Roaming/Embarcadero/BDS/37.0/" , "Templates": "file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/ObjRepos/" } } \ No newline at end of file +{ "settings": { "project": "file:///T%3A/Myc/ASTPlayground/ASTPlayground.dpr", "dllname": "dcc64370.dll", "dccOptions": "-$O- -$W+ --inline:off -$R+ -$Q+ --no-config -Q -TX.exe -AGenerics.Collections=System.Generics.Collections;Generics.Defaults=System.Generics.Defaults;WinTypes=Winapi.Windows;WinProcs=Winapi.Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE -DDEBUG;;FRAMEWORK_FMX -E.\\Win64\\Debug -I\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\debug\\DE\";\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\debug\";\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\release\\DE\";T:\\Myc\\Src\\Data;T:\\Myc\\Src\\AST;T:\\Myc\\Src;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\release\";C:\\Users\\Brummel\\Documents\\Embarcadero\\Studio\\37.0\\Imports\\Win64;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\Imports\";C:\\Users\\Public\\Documents\\Embarcadero\\Studio\\37.0\\Dcp\\Win64;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\include\";S:\\sc_famos_src\\svn_vcl\\Virtual-TreeView\\Source;S:\\sc_famos_src\\svn_vcl\\cpxedits;S:\\sc_famos_src\\svn_vcl\\dzChart;S:\\sc_famos_src\\svn_vcl\\eaeditor;S:\\sc_famos_src\\svn_vcl\\FamosEvents;S:\\sc_famos_src\\svn_vcl\\HTML_Viewer\\source;S:\\sc_famos_src\\svn_vcl\\Myc_ChartEdit;S:\\sc_famos_src\\svn_vcl\\Myc_HemiDrag;S:\\sc_famos_src\\svn_vcl\\Myc_SplitControl;S:\\sc_famos_src\\svn_vcl\\plotter;S:\\sc_famos_src\\svn_vcl\\SimpleIPC;S:\\sc_famos_src\\svn_vcl\\SynEdit-master\\Source;S:\\sc_famos_src\\svn_vcl\\ValEdits;S:\\sc_famos_src\\svn_vcl\\ZipMaster;S:\\sc_famos_src\\svn_common\\Myc_VecMath;\"C:\\Program Files (x86)\\DevExpress VCL\\Library\\RS28\\Win64\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressCore Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressCommon Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressGDI+ Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressLibrary\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\XP Theme Manager\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressLayout Control\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressPageControl\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressEditors Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressDocking Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressBars\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressOfficeCore Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressMemData\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressDataController\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressNavBar\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressSkins Library\\Sources\";S:\\3rdParty\\FastMM5;C:\\Users\\Brummel\\AppData\\Local\\Programs\\TestInsight\\Source;T:\\Myc\\Src;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\source\\DUnitX\" -LEC:\\Users\\Public\\Documents\\Embarcadero\\Studio\\37.0\\Bpl\\Win64 -LNC:\\Users\\Public\\Documents\\Embarcadero\\Studio\\37.0\\Dcp\\Win64 -NU.\\Win64\\Debug -NSWinapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;System;Xml;Data;Datasnap;Web;Soap; -OT:\\Myc\\Src\\Data;T:\\Myc\\Src\\AST;T:\\Myc\\Src;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\release\";C:\\Users\\Brummel\\Documents\\Embarcadero\\Studio\\37.0\\Imports\\Win64;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\Imports\";C:\\Users\\Public\\Documents\\Embarcadero\\Studio\\37.0\\Dcp\\Win64;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\include\";S:\\sc_famos_src\\svn_vcl\\Virtual-TreeView\\Source;S:\\sc_famos_src\\svn_vcl\\cpxedits;S:\\sc_famos_src\\svn_vcl\\dzChart;S:\\sc_famos_src\\svn_vcl\\eaeditor;S:\\sc_famos_src\\svn_vcl\\FamosEvents;S:\\sc_famos_src\\svn_vcl\\HTML_Viewer\\source;S:\\sc_famos_src\\svn_vcl\\Myc_ChartEdit;S:\\sc_famos_src\\svn_vcl\\Myc_HemiDrag;S:\\sc_famos_src\\svn_vcl\\Myc_SplitControl;S:\\sc_famos_src\\svn_vcl\\plotter;S:\\sc_famos_src\\svn_vcl\\SimpleIPC;S:\\sc_famos_src\\svn_vcl\\SynEdit-master\\Source;S:\\sc_famos_src\\svn_vcl\\ValEdits;S:\\sc_famos_src\\svn_vcl\\ZipMaster;S:\\sc_famos_src\\svn_common\\Myc_VecMath;\"C:\\Program Files (x86)\\DevExpress VCL\\Library\\RS28\\Win64\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressCore Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressCommon Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressGDI+ Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressLibrary\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\XP Theme Manager\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressLayout Control\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressPageControl\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressEditors Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressDocking Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressBars\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressOfficeCore Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressMemData\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressDataController\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressNavBar\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressSkins Library\\Sources\";S:\\3rdParty\\FastMM5;C:\\Users\\Brummel\\AppData\\Local\\Programs\\TestInsight\\Source;T:\\Myc\\Src;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\source\\DUnitX\" -R\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\release\\DE\";T:\\Myc\\Src\\Data;T:\\Myc\\Src\\AST;T:\\Myc\\Src;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\release\";C:\\Users\\Brummel\\Documents\\Embarcadero\\Studio\\37.0\\Imports\\Win64;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\Imports\";C:\\Users\\Public\\Documents\\Embarcadero\\Studio\\37.0\\Dcp\\Win64;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\include\";S:\\sc_famos_src\\svn_vcl\\Virtual-TreeView\\Source;S:\\sc_famos_src\\svn_vcl\\cpxedits;S:\\sc_famos_src\\svn_vcl\\dzChart;S:\\sc_famos_src\\svn_vcl\\eaeditor;S:\\sc_famos_src\\svn_vcl\\FamosEvents;S:\\sc_famos_src\\svn_vcl\\HTML_Viewer\\source;S:\\sc_famos_src\\svn_vcl\\Myc_ChartEdit;S:\\sc_famos_src\\svn_vcl\\Myc_HemiDrag;S:\\sc_famos_src\\svn_vcl\\Myc_SplitControl;S:\\sc_famos_src\\svn_vcl\\plotter;S:\\sc_famos_src\\svn_vcl\\SimpleIPC;S:\\sc_famos_src\\svn_vcl\\SynEdit-master\\Source;S:\\sc_famos_src\\svn_vcl\\ValEdits;S:\\sc_famos_src\\svn_vcl\\ZipMaster;S:\\sc_famos_src\\svn_common\\Myc_VecMath;\"C:\\Program Files (x86)\\DevExpress VCL\\Library\\RS28\\Win64\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressCore Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressCommon Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressGDI+ Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressLibrary\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\XP Theme Manager\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressLayout Control\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressPageControl\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressEditors Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressDocking Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressBars\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressOfficeCore Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressMemData\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressDataController\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressNavBar\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressSkins Library\\Sources\";S:\\3rdParty\\FastMM5;C:\\Users\\Brummel\\AppData\\Local\\Programs\\TestInsight\\Source;T:\\Myc\\Src;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\source\\DUnitX\" -U\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\debug\\DE\";\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\debug\";\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\release\\DE\";T:\\Myc\\Src\\Data;T:\\Myc\\Src\\AST;T:\\Myc\\Src;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\release\";C:\\Users\\Brummel\\Documents\\Embarcadero\\Studio\\37.0\\Imports\\Win64;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\Imports\";C:\\Users\\Public\\Documents\\Embarcadero\\Studio\\37.0\\Dcp\\Win64;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\include\";S:\\sc_famos_src\\svn_vcl\\Virtual-TreeView\\Source;S:\\sc_famos_src\\svn_vcl\\cpxedits;S:\\sc_famos_src\\svn_vcl\\dzChart;S:\\sc_famos_src\\svn_vcl\\eaeditor;S:\\sc_famos_src\\svn_vcl\\FamosEvents;S:\\sc_famos_src\\svn_vcl\\HTML_Viewer\\source;S:\\sc_famos_src\\svn_vcl\\Myc_ChartEdit;S:\\sc_famos_src\\svn_vcl\\Myc_HemiDrag;S:\\sc_famos_src\\svn_vcl\\Myc_SplitControl;S:\\sc_famos_src\\svn_vcl\\plotter;S:\\sc_famos_src\\svn_vcl\\SimpleIPC;S:\\sc_famos_src\\svn_vcl\\SynEdit-master\\Source;S:\\sc_famos_src\\svn_vcl\\ValEdits;S:\\sc_famos_src\\svn_vcl\\ZipMaster;S:\\sc_famos_src\\svn_common\\Myc_VecMath;\"C:\\Program Files (x86)\\DevExpress VCL\\Library\\RS28\\Win64\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressCore Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressCommon Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressGDI+ Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressLibrary\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\XP Theme Manager\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressLayout Control\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressPageControl\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressEditors Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressDocking Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressBars\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressOfficeCore Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressMemData\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressDataController\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressNavBar\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressSkins Library\\Sources\";S:\\3rdParty\\FastMM5;C:\\Users\\Brummel\\AppData\\Local\\Programs\\TestInsight\\Source;T:\\Myc\\Src;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\source\\DUnitX\" -V -VN -VR -NBC:\\Users\\Public\\Documents\\Embarcadero\\Studio\\37.0\\Dcp\\Win64 -NHC:\\Users\\Public\\Documents\\Embarcadero\\Studio\\37.0\\hpp\\Win64 -NO.\\Win64\\Debug -LU" , "projectFiles":[ { "name": "MainForm", "file": "file:///T%3A/Myc/ASTPlayground/MainForm.pas" }, { "name": "Myc.Ast.Nodes", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Nodes.pas" }, { "name": "Myc.Ast.Scope", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Scope.pas" }, { "name": "Myc.Data.Value", "file": "file:///T%3A/Myc/ASTPlayground/Myc.Data.Value.pas" }, { "name": "Myc.Ast.Visitor", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Visitor.pas" }, { "name": "Myc.Ast.RTL", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.RTL.pas" }, { "name": "Myc.Ast.Dumper", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Dumper.pas" }, { "name": "Myc.Ast.RTL.Core", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.RTL.Core.pas" }, { "name": "Myc.Fmx.AstEditor.Node", "file": "file:///T%3A/Myc/ASTPlayground/Myc.Fmx.AstEditor.Node.pas" }, { "name": "Myc.Fmx.AstEditor.Workspace", "file": "file:///T%3A/Myc/ASTPlayground/Myc.Fmx.AstEditor.Workspace.pas" }, { "name": "Myc.Fmx.AstEditor.Text", "file": "file:///T%3A/Myc/ASTPlayground/Myc.Fmx.AstEditor.Text.pas" }, { "name": "Myc.Utils", "file": "file:///T%3A/Myc/Src/Myc.Utils.pas" }, { "name": "Myc.Ast.Script", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Script.pas" }, { "name": "Myc.Ast.Types", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Types.pas" }, { "name": "Myc.Data.Keyword", "file": "file:///T%3A/Myc/Src/Data/Myc.Data.Keyword.pas" }, { "name": "Myc.Ast.Compiler.TCO", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Compiler.TCO.pas" }, { "name": "Myc.Ast.Compiler.Binder", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Compiler.Binder.pas" }, { "name": "Myc.Ast.Compiler.Lowering", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Compiler.Lowering.pas" }, { "name": "Myc.Ast.Compiler.TypeChecker", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Compiler.TypeChecker.pas" }, { "name": "Myc.Ast.Compiler.Macros", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Compiler.Macros.pas" }, { "name": "Myc.Ast.Compiler.Specializer", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Compiler.Specializer.pas" }, { "name": "Myc.Ast.Environment", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Environment.pas" }, { "name": "Myc.Ast.Debugger", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Debugger.pas" }, { "name": "Myc.Ast.Analysis.Purity", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Analysis.Purity.pas" } ] , "includeDCUsInUsesCompletion": true, "enableKeyWordCompletion": true, "browsingPaths": [ "file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/OCX/Servers","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/SOURCE/VCL","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/rtl/common","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/SOURCE/RTL/SYS","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/rtl/win","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/rtl/win/winrt","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/ToolsAPI","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/SOURCE/IBX","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/Internet","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/SOURCE/PROPERTY%20EDITORS","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/soap","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/SOURCE/XML","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/Indy10/Core","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/Indy10/System","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/Indy10/Protocols","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/fmx","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/databinding/components","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/databinding/engine","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/databinding/graph","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/ado","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/cloud","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/datasnap","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/dbx","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/dsnap","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/vclctrls","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/datasnap/connectors","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/datasnap/proxygen","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DataExplorer","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnit/Contrib/DUnitWizard/Source/Common","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnit/Contrib/DUnitWizard/Source/Common/dunit","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnit/Contrib/DUnitWizard/Source/DelphiExperts/Common","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnit/Contrib/DUnitWizard/Source/DelphiExperts/DUnitProject","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnit/Contrib/DUnitWizard/Source/DelphiExperts/DUnitProject/dunit","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnit/src","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnit/tests","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/Experts","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/indy/abstraction","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/indy/implementation","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/indyimpl","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/Property%20Editors/Indy10","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/soap/wsdlimporter","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/Visualizers","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnit/Contrib/XMLReporting","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnit/Contrib/XPGen","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/rest","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/firedac","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/tethering","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnitX","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/ems","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/rtl/net","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/FlatBox2D","file:///C%3A/Users/Public/Documents/Embarcadero/Studio/37.0/Dcp/%25PLATFORM%25","file:///%25TP%25/runtime/vcl","file:///S%3A/sc_famos_src/svn_vcl/cpxedits","file:///S%3A/sc_famos_src/svn_vcl/dzChart","file:///S%3A/sc_famos_src/svn_vcl/eaeditor","file:///S%3A/sc_famos_src/svn_vcl/FamosEvents","file:///S%3A/sc_famos_src/svn_vcl/HTML_Viewer/source","file:///S%3A/sc_famos_src/svn_vcl/Myc_ChartEdit","file:///S%3A/sc_famos_src/svn_vcl/Myc_HemiDrag","file:///S%3A/sc_famos_src/svn_vcl/Myc_SplitControl","file:///S%3A/sc_famos_src/svn_vcl/NiceChart","file:///S%3A/sc_famos_src/svn_vcl/plotter","file:///S%3A/sc_famos_src/svn_vcl/SimpleIPC","file:///S%3A/sc_famos_src/svn_vcl/SynEdit-master/Source","file:///S%3A/sc_famos_src/svn_vcl/ValEdits","file:///S%3A/sc_famos_src/svn_vcl/ZipMaster","file:///S%3A/sc_famos_src/svn_vcl/ZipMaster/zlib","file:///S%3A/sc_famos_src/svn_vcl/ZipMaster/zlib/win32","file:///S%3A/sc_famos_src/svn_vcl/Virtual-TreeView/Source","file:///S%3A/sc_famos_src/svn_common/caHelpSys","file:///S%3A/sc_famos_src/svn_common/Misc","file:///S%3A/sc_famos_src/svn_common/Myc_VecMath","file:///S%3A/sc_famos_src/svn_common/PascalScript/source","file:///S%3A/sc_famos_src/svn_common/TreeBase","file:///S%3A/sc_famos_src/svn_common/TreeBase/Medien","file:///S%3A/3rdParty/spring4d/Source","file:///S%3A/3rdParty/spring4d/Source/Base","file:///S%3A/3rdParty/spring4d/Source/Base/Collections","file:///S%3A/3rdParty/spring4d/Source/Base/Logging","file:///S%3A/3rdParty/spring4d/Source/Base/Patches","file:///S%3A/3rdParty/spring4d/Source/Core/Container","file:///S%3A/3rdParty/spring4d/Source/Core/Interception","file:///S%3A/3rdParty/spring4d/Source/Core/Logging","file:///S%3A/3rdParty/spring4d/Source/Core/Mocking","file:///S%3A/3rdParty/spring4d/Source/Core/Services","file:///S%3A/3rdParty/spring4d/Source/Extensions/Cryptography","file:///S%3A/3rdParty/spring4d/Source/Extensions/Utils","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressCore%20Library/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressCommon%20Library/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressGDI%2B%20Library/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressLibrary/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/XP%20Theme%20Manager/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressLayout%20Control/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressPageControl/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressEditors%20Library/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressDocking%20Library/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressBars/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressOfficeCore%20Library/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressMemData/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressDataController/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressNavBar/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressSkins%20Library/Sources","file:///T%3A/Myc/Src","file:///T%3A/Myc/Src/Data","file:///T%3A/Myc/Src/AST" ] , "CommonAppData": "file:///C%3A/Users/Brummel/AppData/Roaming/Embarcadero/BDS/37.0/" , "Templates": "file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/ObjRepos/" } } \ No newline at end of file diff --git a/ASTPlayground/MainForm.pas b/ASTPlayground/MainForm.pas index cf1d221..45e04d2 100644 --- a/ASTPlayground/MainForm.pas +++ b/ASTPlayground/MainForm.pas @@ -531,7 +531,7 @@ begin if (expr.Kind = akVariableDeclaration) then begin var decl := expr.AsVariableDeclaration; - definitions.Add(decl.Identifier.Name, decl.Initializer); + definitions.Add(decl.Target.AsIdentifier.Name, decl.Initializer); end // Handle macro definitions inside the block else if expr.Kind = akMacroDefinition then @@ -546,7 +546,7 @@ begin else if rootNode.Kind = akVariableDeclaration then // Handle single definition begin var decl := rootNode.AsVariableDeclaration; - definitions.Add(decl.Identifier.Name, decl.Initializer); + definitions.Add(decl.Target.AsIdentifier.Name, decl.Initializer); end // Handle a single macro definition else if rootNode.Kind = akMacroDefinition then @@ -825,6 +825,7 @@ begin ); // Execute with RootScope as parent. + //TODO Endlosschleife in HandleTCO result := ExecuteAst(root); sw.Stop; diff --git a/ASTPlayground/Myc.Fmx.AstEditor.Node.pas b/ASTPlayground/Myc.Fmx.AstEditor.Node.pas index 0ee80f4..55917f8 100644 --- a/ASTPlayground/Myc.Fmx.AstEditor.Node.pas +++ b/ASTPlayground/Myc.Fmx.AstEditor.Node.pas @@ -375,6 +375,7 @@ type TVariableDeclarationNodeHandler = class(TInterfacedObject, IAuraNodeHandler) private FNode: IVariableDeclarationNode; + FTargetNode: TAuraNode; FInitializerNode: TAuraNode; // Can be nil function GetAstNode: IAstNode; public @@ -387,6 +388,7 @@ type TAssignmentNodeHandler = class(TInterfacedObject, IAuraNodeHandler) private FNode: IAssignmentNode; + FTargetNode: TAuraNode; FValueNode: TAuraNode; function GetAstNode: IAstNode; public @@ -1782,9 +1784,9 @@ begin OwnerNode.Orientation := loHorizontal; varLabel := OwnerNode.AddLabel(OwnerNode, 'var'); - varLabel.Font.Style := varLabel.Font.Style + [TFontStyle.fsBold]; - OwnerNode.AddLabel(OwnerNode, FNode.Identifier.Name); + varLabel.Font.Style := varLabel.Font.Style + [TFontStyle.fsBold]; + FTargetNode := visu.CallAccept(FNode.Target); if Assigned(FNode.Initializer) then begin @@ -1804,7 +1806,7 @@ begin initAst := FInitializerNode.CreateAst else initAst := nil; - Result := TAst.VarDecl(TAst.Identifier(FNode.Identifier.Name), initAst); + Result := TAst.VarDecl(FTargetNode.CreateAst, initAst); end; { TAssignmentNodeHandler } @@ -1829,7 +1831,7 @@ begin try OwnerNode.Frameless := True; OwnerNode.Orientation := loHorizontal; - OwnerNode.AddLabel(OwnerNode, FNode.Identifier.Name); + FTargetNode := visu.CallAccept(FNode.Target); OwnerNode.AddLabel(OwnerNode, ':='); FValueNode := visu.CallAccept(FNode.Value); finally @@ -1839,7 +1841,7 @@ end; function TAssignmentNodeHandler.ReconstructAst(OwnerNode: TAuraNode): IAstNode; begin - Result := TAst.Assign(TAst.Identifier(FNode.Identifier.Name), FValueNode.CreateAst); + Result := TAst.Assign(FTargetNode.CreateAst, FValueNode.CreateAst); end; { TMacroDefinitionNodeHandler } diff --git a/ASTPlayground/Myc.Fmx.AstEditor.Text.pas b/ASTPlayground/Myc.Fmx.AstEditor.Text.pas index 40fcbf1..6df89da 100644 --- a/ASTPlayground/Myc.Fmx.AstEditor.Text.pas +++ b/ASTPlayground/Myc.Fmx.AstEditor.Text.pas @@ -60,7 +60,7 @@ end; function TAstToTextVisitor.VisitAssignment(const Node: IAssignmentNode): string; begin - Result := Node.Identifier.Name + ' := ' + Accept(Node.Value); + Result := Accept(Node.Target) + ' := ' + Accept(Node.Value); end; function TAstToTextVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): string; @@ -259,7 +259,7 @@ begin initStr := ' := ' + Accept(Node.Initializer) else initStr := ''; - Result := 'var ' + Node.Identifier.Name + initStr; + Result := 'var ' + Accept(Node.Target) + initStr; end; end. diff --git a/Src/AST/Myc.Ast.Compiler.Binder.Upvalues.pas b/Src/AST/Myc.Ast.Compiler.Binder.Upvalues.pas index 167478b..05e6d93 100644 --- a/Src/AST/Myc.Ast.Compiler.Binder.Upvalues.pas +++ b/Src/AST/Myc.Ast.Compiler.Binder.Upvalues.pas @@ -212,7 +212,7 @@ begin // 2. Define the variable in the CURRENT scope // Store the Node reference so we can add it to FBoxedDeclarations if captured. - FCurrentScope.Define(Node.Identifier.Name, Node); + FCurrentScope.Define(Node.Target.AsIdentifier.Name, Node); Result := Node; end; diff --git a/Src/AST/Myc.Ast.Compiler.Binder.pas b/Src/AST/Myc.Ast.Compiler.Binder.pas index a211e23..7abf47f 100644 --- a/Src/AST/Myc.Ast.Compiler.Binder.pas +++ b/Src/AST/Myc.Ast.Compiler.Binder.pas @@ -256,10 +256,11 @@ var newIdent: IIdentifierNode; isBoxed: Boolean; begin - if not IsValidIdentifier(Node.Identifier.Name) then - raise Exception.CreateFmt('Invalid identifier name: "%s".', [Node.Identifier.Name]); + var identifier := Node.Target.AsIdentifier; + if not IsValidIdentifier(identifier.Name) then + raise Exception.CreateFmt('Invalid identifier name: "%s".', [identifier.Name]); - slot := FCurrentBuilder.Define(Node.Identifier.Name); + slot := FCurrentBuilder.Define(identifier.Name); addr := TResolvedAddress.Create(akLocalOrParent, 0, slot); if Assigned(Node.Initializer) then @@ -267,7 +268,7 @@ begin else newInit := nil; - newIdent := TAst.Identifier(Node.Identifier.Name, addr, TTypes.Unknown); + newIdent := TAst.Identifier(identifier.Name, addr, TTypes.Unknown); isBoxed := (FBoxedDeclarations <> nil) and FBoxedDeclarations.Contains(Node); Result := TAst.VarDecl(newIdent, newInit, TTypes.Unknown, isBoxed); @@ -281,7 +282,7 @@ var newIdent: IAstNode; newValue: IAstNode; begin - newIdent := Accept(Node.Identifier); + newIdent := Accept(Node.Target); newValue := Accept(Node.Value); Result := TAst.Assign(newIdent.AsIdentifier, newValue, TTypes.Unknown); diff --git a/Src/AST/Myc.Ast.Compiler.Macros.pas b/Src/AST/Myc.Ast.Compiler.Macros.pas index 8bb62b6..05e365a 100644 --- a/Src/AST/Myc.Ast.Compiler.Macros.pas +++ b/Src/AST/Myc.Ast.Compiler.Macros.pas @@ -87,6 +87,19 @@ type ): IAstNode; static; end; + TMacroRegistry = class(TInterfacedObject, IMacroRegistry) + private + FParent: IMacroRegistry; + FMacros: TDictionary; + function GetParent: IMacroRegistry; + public + constructor Create(AParent: IMacroRegistry); + destructor Destroy; override; + procedure Define(const Node: IMacroDefinitionNode); + function Find(const Name: string): IMacroDefinitionNode; + function CreateChildRegistry: IMacroRegistry; + end; + implementation uses @@ -193,14 +206,23 @@ end; function TExpansionVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode; var + newTarget, newInit: IAstNode; newName: string; - newIdent: IIdentifierNode; - newInit: IAstNode; begin newInit := Accept(Node.Initializer); - newName := Gensym(Node.Identifier.Name); - newIdent := TAst.Identifier(newName, TTypes.Unknown); - Result := TAst.VarDecl(newIdent, newInit, TTypes.Unknown); + + // Check if target is identifier before trying to rename + if Node.Target.Kind = akIdentifier then + begin + newName := Gensym(Node.Target.AsIdentifier.Name); + newTarget := TAst.Identifier(newName, TTypes.Unknown); + end + else + begin + newTarget := Accept(Node.Target); // Recursively expand unquotes in target position! + end; + + Result := TAst.VarDecl(newTarget, newInit, TTypes.Unknown); end; function TExpansionVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode; @@ -438,4 +460,48 @@ begin raise Exception.Create('Unquote-splicing (`~@`) can only be used inside a quasiquote.'); end; +{ TMacroRegistry } + +constructor TMacroRegistry.Create(AParent: IMacroRegistry); +begin + inherited Create; + FParent := AParent; + FMacros := TDictionary.Create; +end; + +destructor TMacroRegistry.Destroy; +begin + FMacros.Free; + inherited Destroy; +end; + +function TMacroRegistry.GetParent: IMacroRegistry; +begin + Result := FParent; +end; + +procedure TMacroRegistry.Define(const Node: IMacroDefinitionNode); +begin + FMacros.AddOrSetValue(Node.Name.Name, Node); +end; + +function TMacroRegistry.Find(const Name: string): IMacroDefinitionNode; +var + current: IMacroRegistry; +begin + current := Self; + while Assigned(current) do + begin + if (current as TMacroRegistry).FMacros.TryGetValue(Name, Result) then + exit; + current := current.Parent; + end; + Result := nil; +end; + +function TMacroRegistry.CreateChildRegistry: IMacroRegistry; +begin + Result := TMacroRegistry.Create(Self); +end; + end. diff --git a/Src/AST/Myc.Ast.Compiler.TypeChecker.pas b/Src/AST/Myc.Ast.Compiler.TypeChecker.pas index e4784f6..65e9b16 100644 --- a/Src/AST/Myc.Ast.Compiler.TypeChecker.pas +++ b/Src/AST/Myc.Ast.Compiler.TypeChecker.pas @@ -240,7 +240,7 @@ var placeholderType: IStaticType; i: Integer; begin - adr := Node.Identifier.Address; + adr := Node.Target.AsIdentifier.Address; initType := TTypes.Unknown; // Recursive lambda bootstrap logic @@ -274,7 +274,7 @@ begin if initType.Kind <> stUnknown then FCurrentContext.SetType(adr.SlotIndex, initType); - newIdent := TAst.Identifier(Node.Identifier.Name, adr, initType); + newIdent := TAst.Identifier(Node.Target.AsIdentifier.Name, adr, initType); Result := TAst.VarDecl(newIdent.AsIdentifier, newInitializer, initType, Node.IsBoxed); end; @@ -288,7 +288,7 @@ var placeholderType: IStaticType; i: Integer; begin - newIdent := Accept(Node.Identifier); + newIdent := Accept(Node.Target); targetType := newIdent.AsTypedNode.StaticType; adr := newIdent.AsIdentifier.Address; diff --git a/Src/AST/Myc.Ast.Debugger.pas b/Src/AST/Myc.Ast.Debugger.pas index 9f832f6..2289941 100644 --- a/Src/AST/Myc.Ast.Debugger.pas +++ b/Src/AST/Myc.Ast.Debugger.pas @@ -162,7 +162,7 @@ end; function TDebugEvaluatorVisitor.VisitAssignment(const Node: IAssignmentNode): TDataValue; begin - AppendLine(Format('Assignment to "%s" {', [Node.Identifier.Name])); + AppendLine(Format('Assignment to "%s" {', [Node.Target.AsIdentifier.Name])); Indent; try Result := inherited VisitAssignment(Node); @@ -278,7 +278,7 @@ end; function TDebugEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; begin - AppendLine(Format('VarDecl %s :=', [Node.Identifier.Name])); + AppendLine(Format('VarDecl %s :=', [Node.Target.AsIdentifier.Name])); Indent; try Result := inherited VisitVariableDeclaration(Node); diff --git a/Src/AST/Myc.Ast.Dumper.pas b/Src/AST/Myc.Ast.Dumper.pas index 474e654..fdea334 100644 --- a/Src/AST/Myc.Ast.Dumper.pas +++ b/Src/AST/Myc.Ast.Dumper.pas @@ -355,7 +355,7 @@ procedure TAstDumper.VisitVariableDeclaration(const Node: IVariableDeclarationNo begin LogFmt('VariableDeclaration (IsBoxed: %s)', [Node.IsBoxed.ToString(TUseBoolStrs.True)], Node); Indent; - Node.Identifier.Accept(Self); + Node.Target.Accept(Self); if Assigned(Node.Initializer) then begin Log('Initializer:'); @@ -368,7 +368,7 @@ procedure TAstDumper.VisitAssignment(const Node: IAssignmentNode); begin Log('Assignment', Node); Indent; - Node.Identifier.Accept(Self); + Node.Target.Accept(Self); Log('Value:'); Node.Value.Accept(Self); Unindent; diff --git a/Src/AST/Myc.Ast.Environment.pas b/Src/AST/Myc.Ast.Environment.pas index c9ebe85..2cc1c8f 100644 --- a/Src/AST/Myc.Ast.Environment.pas +++ b/Src/AST/Myc.Ast.Environment.pas @@ -228,20 +228,6 @@ type function CreateVisitor(const AScope: IExecutionScope): IEvaluatorVisitor; end; - { TMacroRegistryImpl } - TMacroRegistryImpl = class(TInterfacedObject, IMacroRegistry) - private - FParent: IMacroRegistry; - FMacros: TDictionary; - function GetParent: IMacroRegistry; - public - constructor Create(AParent: IMacroRegistry); - destructor Destroy; override; - procedure Define(const Node: IMacroDefinitionNode); - function Find(const Name: string): IMacroDefinitionNode; - function CreateChildRegistry: IMacroRegistry; - end; - TFunctionDefinitionRegistry = class(TInterfacedObject, IFunctionDefinitionRegistry) private FMap: TDictionary; @@ -336,7 +322,7 @@ begin // Initialize root scope with library registration RootScope := TAst.CreateScope(nil, nil, True); - Result.Create(TEnvironment.Create(RootScope, TMacroRegistryImpl.Create(nil), TStandardExecutionStrategy.Create)); + Result.Create(TEnvironment.Create(RootScope, TMacroRegistry.Create(nil), TStandardExecutionStrategy.Create)); end; function TAstEnvironment.CreateEnvironment: TAstEnvironment; @@ -393,50 +379,6 @@ begin Result := TDebugEvaluatorVisitor.Create(AScope, FLog, FShowScope, 0); end; -{ TMacroRegistryImpl } - -constructor TMacroRegistryImpl.Create(AParent: IMacroRegistry); -begin - inherited Create; - FParent := AParent; - FMacros := TDictionary.Create; -end; - -destructor TMacroRegistryImpl.Destroy; -begin - FMacros.Free; - inherited Destroy; -end; - -function TMacroRegistryImpl.GetParent: IMacroRegistry; -begin - Result := FParent; -end; - -procedure TMacroRegistryImpl.Define(const Node: IMacroDefinitionNode); -begin - FMacros.AddOrSetValue(Node.Name.Name, Node); -end; - -function TMacroRegistryImpl.Find(const Name: string): IMacroDefinitionNode; -var - current: IMacroRegistry; -begin - current := Self; - while Assigned(current) do - begin - if (current as TMacroRegistryImpl).FMacros.TryGetValue(Name, Result) then - exit; - current := current.Parent; - end; - Result := nil; -end; - -function TMacroRegistryImpl.CreateChildRegistry: IMacroRegistry; -begin - Result := TMacroRegistryImpl.Create(Self); -end; - { TFunctionDefinitionRegistry } constructor TFunctionDefinitionRegistry.Create; @@ -514,7 +456,7 @@ end; function TEnvironment.CreateEnvironment: IEnvironment; begin - Result := TEnvironment.Create(TAst.CreateScope(FRootScope), TMacroRegistryImpl.Create(FMacroRegistry), FExecutionStrategy); + Result := TEnvironment.Create(TAst.CreateScope(FRootScope), TMacroRegistry.Create(FMacroRegistry), FExecutionStrategy); end; function TEnvironment.Compile( diff --git a/Src/AST/Myc.Ast.Evaluator.pas b/Src/AST/Myc.Ast.Evaluator.pas index 1c793ba..f62a6a1 100644 --- a/Src/AST/Myc.Ast.Evaluator.pas +++ b/Src/AST/Myc.Ast.Evaluator.pas @@ -168,6 +168,7 @@ begin TScalar.TKind.Ordinal: Result := AValue.AsScalar.Value.AsInt64 <> 0; TScalar.TKind.Float: Result := AValue.AsScalar.Value.AsDouble <> 0.0; TScalar.TKind.Keyword: Result := AValue.AsScalar.Value.AsInt64 <> 0; + TScalar.TKind.Boolean: Result := AValue.AsScalar.Value.AsInt64 <> 0; else Result := false; end; @@ -392,10 +393,13 @@ end; function TEvaluatorVisitor.VisitAssignment(const Node: IAssignmentNode): TDataValue; begin - // Evaluate the new value. + if Node.Target.Kind <> akIdentifier then + raise ETypeException.Create('Runtime Error: Assignment target must be an identifier.'); + + // Evaluate value Result := Node.Value.Accept(Self); - // Assign it. - FScope[Node.Identifier.Address] := Result; + // Assign + FScope[Node.Target.AsIdentifier.Address] := Result; end; function TEvaluatorVisitor.VisitConstant(const Node: IConstantNode): TDataValue; @@ -561,6 +565,9 @@ function TEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclara var address: TResolvedAddress; begin + if Node.Target.Kind <> akIdentifier then + raise ETypeException.Create('Runtime Error: Variable declaration target must be an identifier.'); + // 1. Evaluate Initializer if Assigned(Node.Initializer) then Result := Node.Initializer.Accept(Self) @@ -568,7 +575,7 @@ begin Result := TDataValue.Void; // 2. Get Address (assigned by Binder) - address := Node.Identifier.Address; + address := Node.Target.AsIdentifier.Address; // 3. Store Value if Node.IsBoxed then diff --git a/Src/AST/Myc.Ast.JSON.pas b/Src/AST/Myc.Ast.JSON.pas index ebb259f..5ce641a 100644 --- a/Src/AST/Myc.Ast.JSON.pas +++ b/Src/AST/Myc.Ast.JSON.pas @@ -319,7 +319,7 @@ function TJsonAstConverter.VisitVariableDeclaration(const Node: IVariableDeclara var identObj, initObj: TJSONObject; begin - identObj := Accept(Node.Identifier); + identObj := Accept(Node.Target); initObj := Accept(Node.Initializer); // Accept handles nil Result := TJSONObject.Create; @@ -336,7 +336,7 @@ function TJsonAstConverter.VisitAssignment(const Node: IAssignmentNode): TJSONOb var identObj, valueObj: TJSONObject; begin - identObj := Accept(Node.Identifier); + identObj := Accept(Node.Target); valueObj := Accept(Node.Value); Result := TJSONObject.Create; diff --git a/Src/AST/Myc.Ast.Nodes.pas b/Src/AST/Myc.Ast.Nodes.pas index c37773c..4476a03 100644 --- a/Src/AST/Myc.Ast.Nodes.pas +++ b/Src/AST/Myc.Ast.Nodes.pas @@ -287,21 +287,21 @@ type IVariableDeclarationNode = interface(IAstTypedNode) {$region 'private'} - function GetIdentifier: IIdentifierNode; + function GetTarget: IAstNode; function GetInitializer: IAstNode; function GetIsBoxed: Boolean; {$endregion} - property Identifier: IIdentifierNode read GetIdentifier; + property Target: IAstNode read GetTarget; property Initializer: IAstNode read GetInitializer; property IsBoxed: Boolean read GetIsBoxed; end; IAssignmentNode = interface(IAstTypedNode) {$region 'private'} - function GetIdentifier: IIdentifierNode; + function GetTarget: IAstNode; function GetValue: IAstNode; {$endregion} - property Identifier: IIdentifierNode read GetIdentifier; + property Target: IAstNode read GetTarget; property Value: IAstNode read GetValue; end; diff --git a/Src/AST/Myc.Ast.Script.pas b/Src/AST/Myc.Ast.Script.pas index 9ba4b04..9b3c177 100644 --- a/Src/AST/Myc.Ast.Script.pas +++ b/Src/AST/Myc.Ast.Script.pas @@ -574,20 +574,15 @@ begin end else if SameText(head.Token.Text, 'def') then begin - // Validate argument count for 'def' special form. + // Identifier check removed to support macros (e.g. def ~x 1) if not (Length(tailNodes) in [1, 2]) then - raise Exception.CreateFmt( - 'Syntax Error: ''def'' requires an identifier and an optional initializer (1 or 2 arguments), but got %d.', - [Length(tailNodes)]); - - if tailTokens[0].Kind <> tkIdentifier then - raise Exception.Create('Syntax Error: Expected an identifier for def statement.'); + raise Exception.CreateFmt('Syntax Error: ''def'' requires a target and an optional initializer.', []); initializer := nil; if Length(tailNodes) = 2 then initializer := tailNodes[1]; - Result := TAst.VarDecl(IIdentifierNode(tailNodes[0]), initializer); + Result := TAst.VarDecl(tailNodes[0], initializer); end else if SameText(head.Token.Text, 'defmacro') then begin @@ -606,11 +601,11 @@ begin end else if SameText(head.Token.Text, 'assign') then begin + // Identifier check removed if Length(tailNodes) <> 2 then - raise Exception.Create('Syntax Error: ''assign'' requires exactly 2 arguments (identifier and value).'); - if tailTokens[0].Kind <> tkIdentifier then - raise Exception.Create('Syntax Error: Expected an identifier for assignment.'); - Result := TAst.Assign(IIdentifierNode(tailNodes[0]), tailNodes[1]); + raise Exception.Create('Syntax Error: ''assign'' requires exactly 2 arguments (target and value).'); + + Result := TAst.Assign(tailNodes[0], tailNodes[1]); end else if SameText(head.Token.Text, 'fn') then begin @@ -988,7 +983,7 @@ end; procedure TPrettyPrintVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode); begin Append('(def '); - Node.Identifier.Accept(Self); + Node.Target.Accept(Self); if Assigned(Node.Initializer) then begin Append(' '); @@ -1000,7 +995,7 @@ end; procedure TPrettyPrintVisitor.VisitAssignment(const Node: IAssignmentNode); begin Append('(assign '); - Node.Identifier.Accept(Self); + Node.Target.Accept(Self); Append(' '); Node.Value.Accept(Self); Append(')'); diff --git a/Src/AST/Myc.Ast.Visitor.pas b/Src/AST/Myc.Ast.Visitor.pas index d55b862..3cedb7d 100644 --- a/Src/AST/Myc.Ast.Visitor.pas +++ b/Src/AST/Myc.Ast.Visitor.pas @@ -545,35 +545,32 @@ end; function TAstTransformer.VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode; var - newIdent: IIdentifierNode; + newTarget: IAstNode; newInit: IAstNode; begin - // No longer cast to concrete class, use interface - newIdent := Accept(Node.Identifier).AsIdentifier; - newInit := Accept(Node.Initializer); // Accept handles nil + newTarget := Accept(Node.Target); + newInit := Accept(Node.Initializer); - if (newIdent = Node.Identifier) and (newInit = Node.Initializer) then + if (newTarget = Node.Target) and (newInit = Node.Initializer) then Result := Node else begin - // Use TAst factory and copy properties via interface getters - Result := TAst.VarDecl(newIdent, newInit, Node.StaticType, Node.IsBoxed); + Result := TAst.VarDecl(newTarget, newInit, Node.StaticType, Node.IsBoxed); end; end; function TAstTransformer.VisitAssignment(const Node: IAssignmentNode): IAstNode; var - newIdent: IIdentifierNode; + newTarget: IAstNode; newValue: IAstNode; begin + newTarget := Accept(Node.Target); newValue := Accept(Node.Value); - newIdent := Accept(Node.Identifier).AsIdentifier; - if (newValue = Node.Value) and (newIdent = Node.Identifier) then + if (newTarget = Node.Target) and (newValue = Node.Value) then Result := Node else - // Use TAst factory - Result := TAst.Assign(newIdent, newValue, Node.StaticType); + Result := TAst.Assign(newTarget, newValue, Node.StaticType); end; function TAstTransformer.VisitMacroDefinition(const Node: IMacroDefinitionNode): IAstNode; diff --git a/Src/AST/Myc.Ast.pas b/Src/AST/Myc.Ast.pas index b0935c2..0986dae 100644 --- a/Src/AST/Myc.Ast.pas +++ b/Src/AST/Myc.Ast.pas @@ -95,17 +95,13 @@ type class function Block(const AExpressions: array of IAstNode; const AStaticType: IStaticType = nil): IBlockExpressionNode; static; class function VarDecl( - const AIdentifier: IIdentifierNode; + const AIdentifier: IAstNode; AInitializer: IAstNode = nil; const AStaticType: IStaticType = nil; const AIsBoxed: Boolean = False ): IVariableDeclarationNode; static; - class function Assign( - const AIdentifier: IIdentifierNode; - const AValue: IAstNode; - const AStaticType: IStaticType = nil - ): IAssignmentNode; static; + class function Assign(const ATarget, AValue: IAstNode; const AStaticType: IStaticType = nil): IAssignmentNode; static; class function AssignResult(const AValue: IAstNode): IAssignmentNode; static; deprecated; class function Indexer(const ABase: IAstNode; const AIndex: IAstNode; const AStaticType: IStaticType = nil): IIndexerNode; static; class function MemberAccess( @@ -249,23 +245,17 @@ type function AsFunctionCall: IFunctionCallNode; override; end; - // ... (Other node definitions unchanged) ... TVariableDeclarationNode = class(TAstTypedNode, IVariableDeclarationNode) private - FIdentifier: IIdentifierNode; FInitializer: IAstNode; + FTarget: IAstNode; FIsBoxed: Boolean; - function GetIdentifier: IIdentifierNode; + function GetTarget: IAstNode; function GetInitializer: IAstNode; function GetIsBoxed: Boolean; function GetKind: TAstNodeKind; override; public - constructor Create( - const AIdentifier: IIdentifierNode; - AInitializer: IAstNode; - const AStaticType: IStaticType; - const AIsBoxed: Boolean - ); + constructor Create(const ATarget: IAstNode; AInitializer: IAstNode; const AStaticType: IStaticType; const AIsBoxed: Boolean); function Accept(const Visitor: IAstVisitor): TDataValue; override; function AsVariableDeclaration: IVariableDeclarationNode; override; end; @@ -440,16 +430,16 @@ type TAssignmentNode = class(TAstTypedNode, IAssignmentNode) private - FIdentifier: IIdentifierNode; + FTarget: IAstNode; FValue: IAstNode; - function GetIdentifier: IIdentifierNode; + function GetTarget: IAstNode; function GetValue: IAstNode; function GetKind: TAstNodeKind; override; public - constructor Create(const AIdentifier: IIdentifierNode; const AValue: IAstNode; const AStaticType: IStaticType); + constructor Create(const ATarget: IAstNode; const AValue: IAstNode; const AStaticType: IStaticType); function Accept(const Visitor: IAstVisitor): TDataValue; override; function AsAssignment: IAssignmentNode; override; - property Identifier: IIdentifierNode read FIdentifier; + property Target: IAstNode read FTarget; property Value: IAstNode read FValue; end; @@ -619,15 +609,11 @@ begin ); end; -class function TAst.Assign( - const AIdentifier: IIdentifierNode; - const AValue: IAstNode; - const AStaticType: IStaticType = nil -): IAssignmentNode; +class function TAst.Assign(const ATarget, AValue: IAstNode; const AStaticType: IStaticType = nil): IAssignmentNode; begin Result := TAssignmentNode.Create( - AIdentifier, + ATarget, AValue, if AStaticType <> nil then AStaticType else TTypes.Unknown @@ -884,7 +870,7 @@ begin end; class function TAst.VarDecl( - const AIdentifier: IIdentifierNode; + const AIdentifier: IAstNode; AInitializer: IAstNode = nil; const AStaticType: IStaticType = nil; const AIsBoxed: Boolean = False @@ -1614,14 +1600,14 @@ end; { TVariableDeclarationNode } constructor TVariableDeclarationNode.Create( - const AIdentifier: IIdentifierNode; + const ATarget: IAstNode; AInitializer: IAstNode; const AStaticType: IStaticType; const AIsBoxed: Boolean ); begin inherited Create(AStaticType); - FIdentifier := AIdentifier; + FTarget := ATarget; FInitializer := AInitializer; FIsBoxed := AIsBoxed; end; @@ -1636,9 +1622,9 @@ begin Result := Self; end; -function TVariableDeclarationNode.GetIdentifier: IIdentifierNode; +function TVariableDeclarationNode.GetTarget: IAstNode; begin - Result := FIdentifier; + Result := FTarget; end; function TVariableDeclarationNode.GetInitializer: IAstNode; @@ -1658,10 +1644,10 @@ end; { TAssignmentNode } -constructor TAssignmentNode.Create(const AIdentifier: IIdentifierNode; const AValue: IAstNode; const AStaticType: IStaticType); +constructor TAssignmentNode.Create(const ATarget: IAstNode; const AValue: IAstNode; const AStaticType: IStaticType); begin inherited Create(AStaticType); - FIdentifier := AIdentifier; + FTarget := ATarget; FValue := AValue; end; @@ -1675,9 +1661,9 @@ begin Result := Self; end; -function TAssignmentNode.GetIdentifier: IIdentifierNode; +function TAssignmentNode.GetTarget: IAstNode; begin - Result := FIdentifier; + Result := FTarget; end; function TAssignmentNode.GetValue: IAstNode; diff --git a/Src/Data/TestDataTypes.JSON.pas b/Src/Data/TestDataTypes.JSON.pas deleted file mode 100644 index 38d1424..0000000 --- a/Src/Data/TestDataTypes.JSON.pas +++ /dev/null @@ -1,411 +0,0 @@ -unit TestDataTypes.JSON; - -interface - -uses - System.JSON, - DUnitX.TestFramework; - -type - [TestFixture] - [IgnoreMemoryLeaks] - TTestDataTypesJSON = class - private - FJson: TJSONValue; - public - [Setup] - procedure SetUp; - [TearDown] - procedure TearDown; - - [Test] - procedure TestVoid; - - [Test] - [TestCase('Positive', '12345')] - [TestCase('Negative', '-54321')] - [TestCase('Zero', '0')] - procedure TestOrdinal(const AValue: Int64); - - [Test] - [TestCase('Positive', '123.456')] - [TestCase('Negative', '-543.21')] - [TestCase('Zero', '0.0')] - procedure TestFloat(const AValue: Double); - - [Test] - [TestCase('Simple', 'Hello World')] - [TestCase('Empty', '')] - [TestCase('SpecialChars', 'äöüß#+*?%&/()=')] - procedure TestText(const AValue: string); - - [Test] - procedure TestTimestamp; - - [Test] - [TestCase('Scale4_Positive', '1234567,4,123.4567')] - [TestCase('Scale2_Negative', '-987,2,-9.87')] - [TestCase('Scale5_Small', '123,5,0.00123')] - [TestCase('Scale0_Int', '123,0,123')] - [TestCase('Scale2_Zero', '0,2,0.00')] - [TestCase('Scale0_Zero', '0,0,0')] - procedure TestDecimal(const AValue: Int64; AScale: Integer; const AExpectedJsonString: string); - - [Test] - procedure TestEnum; - [Test] - procedure TestRecord; - [Test] - procedure TestTuple; - [Test] - procedure TestArray; - [Test] - procedure TestVector; - [Test] - procedure TestMethodFails; - [Test] - procedure TestNullValue; - end; - -implementation - -uses - System.SysUtils, - System.DateUtils, - System.Math, - Myc.Data.Types, - Myc.Data.Types.JSON; - -{ TTestDataTypesJSON } - -procedure TTestDataTypesJSON.SetUp; -begin - FJson := nil; -end; - -procedure TTestDataTypesJSON.TearDown; -begin - FJson.Free; -end; - -procedure TTestDataTypesJSON.TestVoid; -var - voidType: TDataType.TVoid; - voidValue: TDataType.TVoid.TValue; - deserializedValue: TDataType.TValue; -begin - // Setup - voidType := TDataType.Void; - voidValue := voidType.Value; - - // Serialize - FJson := TDataJsonConverter.ValueToJson(voidValue); - Assert.IsNotNull(FJson, 'JSON value should not be nil'); - Assert.IsTrue(FJson is TJSONNull, 'Void should serialize to JSON Null'); - - // Deserialize - deserializedValue := TDataJsonConverter.JsonToValue(FJson, voidType); - Assert.IsNotNull(deserializedValue.DataValue, 'Deserialized value should not be nil'); - Assert.AreEqual(dkVoid, deserializedValue.DataType.Kind, 'Deserialized type kind should be dkVoid'); -end; - -procedure TTestDataTypesJSON.TestOrdinal(const AValue: Int64); -var - ordType: TDataType.TOrdinal; - ordValue: TDataType.TOrdinal.TValue; - deserializedValue: TDataType.TValue; -begin - // Setup - ordType := TDataType.Ordinal; - ordValue := ordType.CreateValue(AValue); - - // Serialize - FJson := TDataJsonConverter.ValueToJson(ordValue); - Assert.IsTrue(FJson is TJSONNumber, 'Ordinal should serialize to JSON Number'); - Assert.AreEqual(AValue, (FJson as TJSONNumber).AsInt64, 'Serialized value mismatch'); - - // Deserialize - deserializedValue := TDataJsonConverter.JsonToValue(FJson, ordType); - Assert.AreEqual(dkOrdinal, deserializedValue.DataType.Kind, 'Deserialized type kind should be dkOrdinal'); - Assert.AreEqual(AValue, deserializedValue.AsOrdinal.Value, 'Deserialized value mismatch'); -end; - -procedure TTestDataTypesJSON.TestFloat(const AValue: Double); -var - floatType: TDataType.TFloat; - floatValue: TDataType.TFloat.TValue; - deserializedValue: TDataType.TValue; -begin - // Setup - floatType := TDataType.Float; - floatValue := floatType.CreateValue(AValue); - - // Serialize - FJson := TDataJsonConverter.ValueToJson(floatValue); - Assert.IsTrue(FJson is TJSONNumber, 'Float should serialize to JSON Number'); - Assert.AreEqual(AValue, (FJson as TJSONNumber).AsDouble, 1E-9, 'Serialized value mismatch'); - - // Deserialize - deserializedValue := TDataJsonConverter.JsonToValue(FJson, floatType); - Assert.AreEqual(dkFloat, deserializedValue.DataType.Kind, 'Deserialized type kind should be dkFloat'); - Assert.AreEqual(AValue, deserializedValue.AsFloat.Value, 1E-9, 'Deserialized value mismatch'); -end; - -procedure TTestDataTypesJSON.TestText(const AValue: string); -var - textType: TDataType.TText; - textValue: TDataType.TText.TValue; - deserializedValue: TDataType.TValue; -begin - // Setup - textType := TDataType.Text; - textValue := textType.CreateValue(AValue); - - // Serialize - FJson := TDataJsonConverter.ValueToJson(textValue); - Assert.IsTrue(FJson is TJSONString, 'Text should serialize to JSON String'); - Assert.AreEqual(AValue, (FJson as TJSONString).Value, 'Serialized value mismatch'); - - // Deserialize - deserializedValue := TDataJsonConverter.JsonToValue(FJson, textType); - Assert.AreEqual(dkText, deserializedValue.DataType.Kind, 'Deserialized type kind should be dkText'); - Assert.AreEqual(AValue, deserializedValue.AsText.Value, 'Deserialized value mismatch'); -end; - -procedure TTestDataTypesJSON.TestTimestamp; -var - tsType: TDataType.TTimestamp; - tsValue: TDataType.TTimestamp.TValue; - deserializedValue: TDataType.TValue; - testVal: TDateTime; -begin - // Setup - testVal := EncodeDateTime(2025, 8, 27, 17, 30, 15, 500); - tsType := TDataType.Timestamp; - tsValue := tsType.CreateValue(testVal); - - // Serialize - FJson := TDataJsonConverter.ValueToJson(tsValue); - Assert.IsTrue(FJson is TJSONString, 'Timestamp should serialize to JSON String'); - Assert.AreEqual(DateToISO8601(testVal, true), (FJson as TJSONString).Value, 'Serialized value mismatch'); - - // Deserialize - deserializedValue := TDataJsonConverter.JsonToValue(FJson, tsType); - Assert.AreEqual(dkTimestamp, deserializedValue.DataType.Kind, 'Deserialized type kind should be dkTimestamp'); - Assert.IsTrue(CompareDateTime(testVal, deserializedValue.AsTimestamp.Value) = 0, 'Deserialized value mismatch'); -end; - -procedure TTestDataTypesJSON.TestDecimal(const AValue: Int64; AScale: Integer; const AExpectedJsonString: string); -var - decType: TDataType.TDecimal; - decValue: TDataType.TDecimal.TValue; - deserializedValue: TDataType.TValue; -begin - // Setup - decType := TDataType.DecimalOf(AScale); - decValue := decType.CreateValue(AValue); - - // Serialize - FJson := TDataJsonConverter.ValueToJson(decValue); - Assert.IsTrue(FJson is TJSONString, 'Decimal should serialize to JSON String'); - Assert.AreEqual(AExpectedJsonString, (FJson as TJSONString).Value, 'Serialized string value mismatch'); - - // Deserialize - deserializedValue := TDataJsonConverter.JsonToValue(FJson, decType); - Assert.AreEqual(dkDecimal, deserializedValue.DataType.Kind, 'Deserialized type kind should be dkDecimal'); - Assert.AreEqual(AValue, deserializedValue.AsDecimal.Value, 'Deserialized value mismatch'); - Assert.AreEqual(AScale, deserializedValue.AsDecimal.DataType.Scale, 'Deserialized scale mismatch'); - - // Test Deserialization from Number (compatibility) - FJson.Free; // Free previous value before creating new one - FJson := TJSONNumber.Create(AValue / Power(10, AScale)); - deserializedValue := TDataJsonConverter.JsonToValue(FJson, decType); - Assert.AreEqual(AValue, deserializedValue.AsDecimal.Value, 'Deserialized value from number mismatch'); -end; - -procedure TTestDataTypesJSON.TestEnum; -var - enumType: TDataType.TEnum; - enumValue: TDataType.TEnum.TValue; - deserializedValue: TDataType.TValue; -begin - // Setup - enumType := TDataType.EnumOf('MyEnum', ['Red', 'Green', 'Blue']); - enumValue := enumType.CreateValue(1); // Green - - // Serialize - FJson := TDataJsonConverter.ValueToJson(enumValue); - Assert.IsTrue(FJson is TJSONString, 'Enum should serialize to JSON String'); - Assert.AreEqual('Green', (FJson as TJSONString).Value, 'Serialized value mismatch'); - - // Deserialize - deserializedValue := TDataJsonConverter.JsonToValue(FJson, enumType); - Assert.AreEqual(dkEnum, deserializedValue.DataType.Kind, 'Deserialized type kind should be dkEnum'); - Assert.AreEqual(1, deserializedValue.AsEnum.Value, 'Deserialized value mismatch'); -end; - -procedure TTestDataTypesJSON.TestRecord; -var - recordType: TDataType.TRecord; - idVal: TDataType.TOrdinal.TValue; - nameVal: TDataType.TText.TValue; - recordValue: TDataType.TRecord.TValue; - deserializedValue: TDataType.TValue; -begin - // Setup - recordType := TDataType.RecordOf([TDataRecordField.Create('ID', TDataType.Ordinal), TDataRecordField.Create('Name', TDataType.Text)]); - idVal := TDataType.Ordinal.CreateValue(99); - nameVal := TDataType.Text.CreateValue('TestRecord'); - recordValue := recordType.CreateValue([idVal, nameVal]); - - // Serialize - FJson := TDataJsonConverter.ValueToJson(recordValue); - Assert.IsTrue(FJson is TJSONObject, 'Record should serialize to JSON Object'); - - // Deserialize - deserializedValue := TDataJsonConverter.JsonToValue(FJson, recordType); - Assert.AreEqual(dkRecord, deserializedValue.DataType.Kind, 'Deserialized type kind should be dkRecord'); - var desRecord := deserializedValue.AsRecord; - Assert.AreEqual(Int64(99), desRecord.Items[0].AsOrdinal.Value, 'Deserialized record field ID mismatch'); - Assert.AreEqual('TestRecord', desRecord.Items[1].AsText.Value, 'Deserialized record field Name mismatch'); -end; - -procedure TTestDataTypesJSON.TestTuple; -var - tupleType: TDataType.TTuple; - idVal: TDataType.TOrdinal.TValue; - nameVal: TDataType.TText.TValue; - tupleValue: TDataType.TTuple.TValue; - deserializedValue: TDataType.TValue; -begin - // Setup - tupleType := TDataType.TupleOf([TDataType.Ordinal, TDataType.Text]); - idVal := TDataType.Ordinal.CreateValue(101); - nameVal := TDataType.Text.CreateValue('TestTuple'); - tupleValue := tupleType.CreateValue([idVal, nameVal]); - - // Serialize - FJson := TDataJsonConverter.ValueToJson(tupleValue); - Assert.IsTrue(FJson is TJSONArray, 'Tuple should serialize to JSON Array'); - - // Deserialize - deserializedValue := TDataJsonConverter.JsonToValue(FJson, tupleType); - Assert.AreEqual(dkTuple, deserializedValue.DataType.Kind, 'Deserialized type kind should be dkTuple'); - var desTuple := deserializedValue.AsTuple; - Assert.AreEqual(Int64(101), desTuple.Items[0].AsOrdinal.Value, 'Deserialized tuple item 0 mismatch'); - Assert.AreEqual('TestTuple', desTuple.Items[1].AsText.Value, 'Deserialized tuple item 1 mismatch'); -end; - -procedure TTestDataTypesJSON.TestArray; -var - arrayType: TDataType.TArray; - val1, val2: TDataType.TText.TValue; - arrayValue: TDataType.TArray.TValue; - deserializedValue: TDataType.TValue; -begin - // Setup - arrayType := TDataType.ArrayOf(TDataType.Text); - val1 := TDataType.Text.CreateValue('A'); - val2 := TDataType.Text.CreateValue('B'); - arrayValue := arrayType.CreateValue([val1, val2]); - - // Serialize - FJson := TDataJsonConverter.ValueToJson(arrayValue); - Assert.IsTrue(FJson is TJSONArray, 'Array should serialize to JSON Array'); - - // Deserialize - deserializedValue := TDataJsonConverter.JsonToValue(FJson, arrayType); - Assert.AreEqual(dkArray, deserializedValue.DataType.Kind, 'Deserialized type kind should be dkArray'); - var desArray := deserializedValue.AsArray; - Assert.AreEqual(2, desArray.ElementCount, 'Deserialized array element count mismatch'); - Assert.AreEqual('A', desArray.Items[0].AsText.Value, 'Deserialized array item 0 mismatch'); - Assert.AreEqual('B', desArray.Items[1].AsText.Value, 'Deserialized array item 1 mismatch'); -end; - -procedure TTestDataTypesJSON.TestVector; -var - vectorType: TDataType.TVector; - val1, val2: TDataType.TOrdinal.TValue; - vectorValue: TDataType.TVector.TValue; - deserializedValue: TDataType.TValue; - jsonArray: TJSONArray; -begin - // Setup - vectorType := TDataType.VectorOf(TDataType.Ordinal, 2); - val1 := TDataType.Ordinal.CreateValue(10); - val2 := TDataType.Ordinal.CreateValue(20); - vectorValue := vectorType.CreateValue([val1, val2]); - - // Serialize - FJson := TDataJsonConverter.ValueToJson(vectorValue); - Assert.IsTrue(FJson is TJSONArray, 'Vector should serialize to JSON Array'); - - // Deserialize - deserializedValue := TDataJsonConverter.JsonToValue(FJson, vectorType); - Assert.AreEqual(dkVector, deserializedValue.DataType.Kind, 'Deserialized type kind should be dkVector'); - var desVector := deserializedValue.AsVector; - Assert.AreEqual(2, desVector.ElementCount, 'Deserialized vector element count mismatch'); - Assert.AreEqual(Int64(10), desVector.Items[0].AsOrdinal.Value, 'Deserialized vector item 0 mismatch'); - Assert.AreEqual(Int64(20), desVector.Items[1].AsOrdinal.Value, 'Deserialized vector item 1 mismatch'); - - // Test wrong size deserialization - jsonArray := nil; - try - jsonArray := TJSONArray.Create; - jsonArray.Add(1); - Assert.WillRaise( - procedure begin TDataJsonConverter.JsonToValue(jsonArray, vectorType); end, - EConvertError, - 'Deserializing a JSON array with wrong size for a vector should raise an exception' - ); - finally - jsonArray.Free; - end; -end; - -procedure TTestDataTypesJSON.TestMethodFails; -var - methodType: TDataType.TMethod; - methodValue: TDataType.TMethod.TValue; -begin - // Setup - methodType := TDataType.MethodOf(TDataType.Ordinal, TDataType.Ordinal); - methodValue := methodType.CreateValue(function(const AValue: TDataType.TValue): TDataType.TValue begin Result := AValue; end); - - // Test Serialization - Assert.WillRaise( - procedure begin TDataJsonConverter.ValueToJson(methodValue).Free; end, - ENotSupportedException, - 'Serializing a method should raise an exception' - ); - - // Test Deserialization - FJson := TJSONNull.Create; - Assert.WillRaise( - procedure begin TDataJsonConverter.JsonToValue(FJson, methodType); end, - ENotSupportedException, - 'Deserializing a method should raise an exception' - ); -end; - -procedure TTestDataTypesJSON.TestNullValue; -var - value: TDataType.TValue; - deserializedValue: TDataType.TValue; -begin - // Setup - value := TDataType.Void.Value; - - // Serialize - FJson := TDataJsonConverter.ValueToJson(value); - Assert.IsTrue(FJson is TJSONNull, 'nil IDataValue should serialize to JSON Null'); - - // Deserialize - deserializedValue := TDataJsonConverter.JsonToValue(FJson, TDataType.Void); - Assert.IsTrue(deserializedValue.DataType.Kind = dkVoid, 'JSON Null should deserialize to a TValue with a nil DataValue'); -end; - -initialization - TDUnitX.RegisterTestFixture(TTestDataTypesJSON); - -end. diff --git a/Src/Data/TestDataTypes.pas b/Src/Data/TestDataTypes.pas deleted file mode 100644 index c05c8a5..0000000 --- a/Src/Data/TestDataTypes.pas +++ /dev/null @@ -1,676 +0,0 @@ -unit TestDataTypes; - -interface - -uses - DUnitX.TestFramework; - -type - [TestFixture] - [IgnoreMemoryLeaks] - TTestDataTypes = class - public - [Test] - procedure TestRecords; - [Test] - procedure TestRecords_Generic; - [Test] - procedure TestTuples; - [Test] - procedure TestTuples_Generic; - [Test] - procedure TestArrays; - [Test] - procedure TestArrays_OptimizedAndGeneric; - [Test] - procedure TestTexts; - [Test] - procedure TestTexts_OptimizedEmpty; - [Test] - procedure TestFloats_OptimizedAndGeneric; - [Test] - procedure TestTimestamps; - [Test] - procedure TestEnums; - [Test] - procedure TestAsString; - [Test] - procedure TestAsTValue; - [Test] - procedure TestMethods; - end; - -implementation - -uses - System.SysUtils, - System.Math, - System.Rtti, - System.TypInfo, - Myc.Data.Types, - Myc.Data.Types.RTTI, - Myc.Data.Types.JSON; - -procedure TTestDataTypes.TestRecords; -var - intType: TDataType.TOrdinal; - floatType: TDataType.TFloat; - personType1, personType2, otherType: TDataType.TRecord; - personValue: TDataType.TRecord.TValue; - idValue: TDataType.TOrdinal.TValue; - floatValue: TDataType.TFloat.TValue; -begin - // This test covers the optimized implementation for 2 fields. - // --- 1. Setup: Define base types and a record structure --- - intType := TDataType.Ordinal; - floatType := TDataType.Float; - - // --- 2. Test Type Creation and Caching --- - personType1 := TDataType.RecordOf([TDataRecordField.Create('ID', intType), TDataRecordField.Create('Value', floatType)]); - - // Assertions for the created type - Assert.IsNotNull(IDataRecordType(personType1), 'RecordType should be created'); - Assert.AreEqual(2, personType1.FieldCount, 'FieldCount should be 2'); - Assert.AreEqual('ID', personType1.Fields[0].Name, 'First field name should be ID'); - Assert.AreSame(IDataType(intType), personType1.Fields[0].DataType, 'First field type should be Integer'); - Assert.AreEqual('Value', personType1.Fields[1].Name, 'Second field name should be Value'); - Assert.AreSame(IDataType(floatType), personType1.Fields[1].DataType, 'Second field type should be Float'); - Assert.AreEqual(0, personType1.IndexOf('ID'), 'IndexOf ID should be 0'); - Assert.AreEqual(1, personType1.IndexOf('Value'), 'IndexOf Value should be 1'); - Assert.AreEqual('Record', TDataType(personType1).Name, 'Type name should match expected format'); - - // Test if the same definition returns the same cached instance - personType2 := TDataType.RecordOf([TDataRecordField.Create('ID', intType), TDataRecordField.Create('Value', floatType)]); - Assert.AreSame(IDataRecordType(personType1), IDataRecordType(personType2), 'Types should be cached and return the same instance'); - - // Test if a different definition returns a new instance - otherType := TDataType.RecordOf([TDataRecordField.Create('ID', intType), TDataRecordField.Create('Data', floatType)]); - Assert.AreNotSame(IDataRecordType(personType1), IDataRecordType(otherType), 'Different definitions should result in different types'); - - // --- 3. Test Value Creation and Access --- - personValue := personType1.CreateValue([TDataType.Ordinal.CreateValue(123), TDataType.Float.CreateValue(45.67)]); - - Assert.IsNotNull(IDataRecordValue(personValue), 'RecordValue should be created'); - Assert.AreSame(IDataRecordType(personType1), IDataRecordType(personValue.DataType), 'Value should have the correct data type'); - - // Access by index - idValue := TDataType.TValue(personValue.Items[0]).AsOrdinal; - Assert.AreEqual(Int64(123), idValue.Value, 'Value at index 0 is incorrect'); - floatValue := TDataType.TValue(personValue.Items[1]).AsFloat; - Assert.AreEqual(45.67, floatValue.Value, 'Value at index 1 is incorrect'); - - // Access by name - floatValue := TDataType.TValue(personValue.Items[personType1.IndexOf('Value')]).AsFloat; - Assert.AreEqual(45.67, floatValue.Value, 'Value accessed by name is incorrect'); - - // --- 4. Test Validation and Error Handling --- - // Test for duplicate field names during type creation - Assert.WillRaise( - procedure begin TDataType.RecordOf([TDataRecordField.Create('ID', intType), TDataRecordField.Create('ID', floatType)]); end, - EArgumentException, - 'Duplicate field names should raise an exception' - ); - - // Test for wrong number of items during value creation - Assert.WillRaise( - procedure begin personType1.CreateValue([TDataType.Ordinal.CreateValue(99)]); end, - EArgumentException, - 'Wrong number of items should raise exception' - ); - - // Test for wrong item type during value creation - Assert.WillRaise( - procedure - begin - // Passing Float instead of Integer for the first item - personType1.CreateValue([TDataType.Float.CreateValue(1.0), TDataType.Float.CreateValue(2.0)]); - end, - EArgumentException, - 'Wrong item type should raise exception' - ); -end; - -procedure TTestDataTypes.TestRecords_Generic; -var - dataType: TDataType.TRecord; - dataValue: TDataType.TRecord.TValue; -begin - // Test the generic implementation for records with > 2 fields. - dataType := - TDataType.RecordOf( - [ - TDataRecordField.Create('A', TDataType.Ordinal), - TDataRecordField.Create('B', TDataType.Text), - TDataRecordField.Create('C', TDataType.Float) - ] - ); - dataValue := - dataType.CreateValue([TDataType.Ordinal.CreateValue(1), TDataType.Text.CreateValue('two'), TDataType.Float.CreateValue(3.0)]); - - Assert.IsNotNull(IDataRecordValue(dataValue), 'Generic record value should be created'); - Assert.AreEqual(3, dataType.FieldCount, 'Generic record should have 3 fields'); - - var itemValue0 := dataValue.Items[0].AsOrdinal; - Assert.AreEqual(Int64(1), itemValue0.Value, 'Field A is incorrect'); - var itemValue1 := dataValue.Items[1].AsText; - Assert.AreEqual('two', itemValue1.Value, 'Field B is incorrect'); - var itemValue2 := dataValue.Items[2].AsFloat; - Assert.AreEqual(3.0, itemValue2.Value, 'Field C is incorrect'); - - Assert.AreEqual('', IDataValue(dataValue).AsString, 'Generic record AsString is incorrect'); -end; - -procedure TTestDataTypes.TestTuples; -var - intValue: TDataType.TOrdinal.TValue; - floatValue: TDataType.TFloat.TValue; - tuple1, tuple2, tuple3: TDataType.TTuple.TValue; - type1, type2, type3: IDataType; // Keep as interface to test AreSame on the raw interface pointer -begin - // This test covers optimized implementations for 1 and 2 elements. - // --- 1. Setup: Create some values --- - intValue := TDataType.Ordinal.CreateValue(123); - floatValue := TDataType.Float.CreateValue(45.67); - - // --- 2. Test Value Creation and basic properties --- - tuple1 := TDataType.TupleOf([intValue, floatValue]); - - Assert.IsNotNull(IDataTupleValue(tuple1), 'Tuple value should be created'); - Assert.AreEqual(2, tuple1.ItemCount, 'ItemCount should be on the value'); - Assert.AreSame(IDataValue(intValue), tuple1.Items[0], 'Item at index 0 is incorrect'); - Assert.AreSame(IDataValue(floatValue), tuple1.Items[1], 'Item at index 1 is incorrect'); - - // --- 3. Test Singleton Type Behavior --- - // Create more tuples with different structures - tuple2 := TDataType.TupleOf([TDataType.Ordinal.CreateValue(99), TDataType.Float.CreateValue(1.1)]); - tuple3 := TDataType.TupleOf([intValue]); - - // Access the DataType via the underlying interface - type1 := tuple1.DataType; - type2 := tuple2.DataType; - type3 := tuple3.DataType; - - Assert.IsNotNull(type1, 'DataType interface should be accessible'); - Assert.AreEqual('Tuple', type1.Name, 'The type name for all tuples should be Tuple'); -end; - -procedure TTestDataTypes.TestTuples_Generic; -var - tupleValue: TDataType.TTuple.TValue; - item: TDataType.TOrdinal.TValue; -begin - // Test the generic implementation for tuples with > 5 elements. - tupleValue := - TDataType.TupleOf( - [ - TDataType.Ordinal.CreateValue(1), - TDataType.Ordinal.CreateValue(2), - TDataType.Ordinal.CreateValue(3), - TDataType.Ordinal.CreateValue(4), - TDataType.Ordinal.CreateValue(5), - TDataType.Ordinal.CreateValue(6) - ] - ); - - Assert.IsNotNull(IDataTupleValue(tupleValue), 'Generic tuple value should be created'); - Assert.AreEqual(6, tupleValue.ItemCount, 'Generic tuple should have 6 items'); - - item := TDataType.TValue(tupleValue.Items[5]).AsOrdinal; - Assert.AreEqual(Int64(6), item.Value, 'Last item is incorrect'); - Assert.AreEqual('(1, 2, 3, 4, 5, 6)', IDataValue(tupleValue).AsString, 'Generic tuple AsString is incorrect'); -end; - -procedure TTestDataTypes.TestArrays; -var - intType: TDataType.TOrdinal; - floatType: TDataType.TFloat; - intArrayType1, intArrayType2: TDataType.TArray; - floatArrayType: TDataType.TArray; - arrayValue: TDataType.TArray.TValue; - v1, v2: TDataType.TOrdinal.TValue; - item: TDataType.TOrdinal.TValue; -begin - // --- 1. Setup --- - intType := TDataType.Ordinal; - floatType := TDataType.Float; - - // --- 2. Test Type Creation and Caching --- - intArrayType1 := TDataType.ArrayOf(intType); - - Assert.IsNotNull(IDataArrayType(intArrayType1), 'ArrayType should be created'); - Assert.AreSame(IDataType(intType), intArrayType1.ElementType, 'ElementType should be Integer'); - Assert.AreEqual('Array', TDataType(intArrayType1).Name, 'Type name should be Array'); - - // Test caching - intArrayType2 := TDataType.ArrayOf(intType); - Assert.AreSame(IDataArrayType(intArrayType1), IDataArrayType(intArrayType2), 'Array types should be cached'); - - // Test uniqueness - floatArrayType := TDataType.ArrayOf(floatType); - Assert.AreNotSame( - IDataArrayType(intArrayType1), - IDataArrayType(floatArrayType), - 'Different element types should result in different array types' - ); - Assert.AreEqual('Array', TDataType(floatArrayType).Name, 'Type name should be Array'); - - // --- 3. Test Value Creation and Access --- - v1 := TDataType.Ordinal.CreateValue(10); - v2 := TDataType.Ordinal.CreateValue(20); - arrayValue := intArrayType1.CreateValue([v1, v2]); - - Assert.IsNotNull(IDataArrayValue(arrayValue), 'ArrayValue should be created'); - Assert.AreEqual(2, arrayValue.ElementCount, 'ElementCount should be 2'); - - // Access items and check values - item := TDataType.TValue(arrayValue.Items[0]).AsOrdinal; - Assert.AreEqual(Int64(10), item.Value, 'Item at index 0 is incorrect'); - item := TDataType.TValue(arrayValue.Items[1]).AsOrdinal; - Assert.AreEqual(Int64(20), item.Value, 'Item at index 1 is incorrect'); - - // --- 4. Test Validation and Error Handling --- - // Test creating an array with a nil element type - Assert.WillRaise(procedure begin TDataType.ArrayOf(nil); end, EArgumentException, 'Nil element type should raise an exception'); - - // Test creating a value with an incorrect element type (homogeneity check) - Assert.WillRaise( - procedure - begin - // Try to add a float value to an Array - intArrayType1.CreateValue([v1, TDataType.Float.CreateValue(3.14)]); - end, - EArgumentException, - 'Wrong element type should raise an exception' - ); -end; - -procedure TTestDataTypes.TestArrays_OptimizedAndGeneric; -var - arrayType: TDataType.TArray; - empty1, empty2, single, generic: TDataType.TArray.TValue; - item: TDataType.TOrdinal.TValue; -begin - arrayType := TDataType.ArrayOf(TDataType.Ordinal); - - // Test optimized path for 0 elements (cached singleton per type) - empty1 := arrayType.CreateValue([]); - empty2 := arrayType.CreateValue([]); - Assert.IsNotNull(IDataArrayValue(empty1), 'Empty array value should be created'); - Assert.AreSame(IDataArrayValue(empty1), IDataArrayValue(empty2), 'Empty array value should be cached and reused'); - Assert.AreEqual(0, empty1.ElementCount, 'Empty array should have 0 elements'); - Assert.AreEqual('[]', IDataValue(empty1).AsString, 'Empty array AsString is incorrect'); - - // Test optimized path for 1 element - single := arrayType.CreateValue([TDataType.Ordinal.CreateValue(42)]); - Assert.IsNotNull(IDataArrayValue(single), 'Single element array should be created'); - Assert.AreEqual(1, single.ElementCount, 'Single element array should have 1 element'); - - item := TDataType.TValue(single.Items[0]).AsOrdinal; - Assert.AreEqual(Int64(42), item.Value, 'Single element value is incorrect'); - Assert.AreEqual('[42]', IDataValue(single).AsString, 'Single element array AsString is incorrect'); - - // Test generic path for > 1 elements - generic := - arrayType.CreateValue([TDataType.Ordinal.CreateValue(1), TDataType.Ordinal.CreateValue(2), TDataType.Ordinal.CreateValue(3)]); - Assert.IsNotNull(IDataArrayValue(generic), 'Generic array should be created'); - Assert.AreEqual(3, generic.ElementCount, 'Generic array should have 3 elements'); - Assert.AreEqual('[1, 2, 3]', IDataValue(generic).AsString, 'Generic array AsString is incorrect'); -end; - -procedure TTestDataTypes.TestTexts; -var - textType: TDataType.TText; - textValue1, textValue2, castedValue: TDataType.TText.TValue; - dataValue: IDataValue; -begin - // --- 1. Test Type Creation --- - textType := TDataType.Text; - - Assert.IsNotNull(IDataTextType(textType), 'TextType should be created'); - Assert.AreEqual('Text', TDataType(textType).Name, 'Type name should be Text'); - Assert.AreEqual(dkText, TDataType(textType).Kind, 'Type kind should be dkText'); - - // --- 2. Test Value Creation and Access --- - textValue1 := TDataType.Text.CreateValue('Hello World'); - - Assert.IsNotNull(IDataTextValue(textValue1), 'TextValue should be created'); - Assert.AreSame(IDataType(textType), IDataType(textValue1.DataType), 'Value should have the correct data type'); - Assert.AreEqual('Hello World', textValue1.Value, 'Value should be ''Hello World'''); - - // Test another text value - textValue2 := TDataType.Text.CreateValue('Delphi'); - Assert.AreEqual('Delphi', textValue2.Value, 'Value should be ''Delphi'''); - - // --- 3. Test AsText casting --- - dataValue := TDataType.Text.CreateValue('Test Text'); - castedValue := TDataType.TValue(dataValue).AsText; - Assert.AreEqual('Test Text', castedValue.Value, 'AsText should return correct value'); - - // Test invalid cast - dataValue := TDataType.Ordinal.CreateValue(123); - Assert.WillRaise( - procedure begin TDataType.TValue(dataValue).AsText; end, - EInvalidCast, - 'Casting non-text to AsText should raise EInvalidCast' - ); -end; - -procedure TTestDataTypes.TestTexts_OptimizedEmpty; -var - empty1, empty2: TDataType.TText.TValue; -begin - // Test the singleton implementation for the empty string. - empty1 := TDataType.Text.CreateValue(''); - empty2 := TDataType.Text.CreateValue(''); - - Assert.IsNotNull(IDataTextValue(empty1), 'Empty text value should be created'); - Assert.AreSame(IDataTextValue(empty1), IDataTextValue(empty2), 'Empty text value should be a singleton'); - Assert.AreEqual('', empty1.Value, 'Value of empty text should be empty'); - Assert.AreEqual('', IDataValue(empty1).AsString, 'AsString of empty text should be empty'); -end; - -procedure TTestDataTypes.TestFloats_OptimizedAndGeneric; -var - zero1, zero2, nan1, nan2, generic: TDataType.TFloat.TValue; -begin - // Test singleton for 0.0 - zero1 := TDataType.Float.CreateValue(0.0); - zero2 := TDataType.Float.CreateValue(0.0); - Assert.IsNotNull(IDataFloatValue(zero1), 'Zero float should be created'); - Assert.AreSame(IDataFloatValue(zero1), IDataFloatValue(zero2), 'Zero float should be a singleton'); - Assert.AreEqual(0.0, zero1.Value, 'Value of zero float is incorrect'); - - // Test singleton for NaN - nan1 := TDataType.Float.CreateValue(NaN); - nan2 := TDataType.Float.CreateValue(NaN); - Assert.IsNotNull(IDataFloatValue(nan1), 'NaN float should be created'); - Assert.AreSame(IDataFloatValue(nan1), IDataFloatValue(nan2), 'NaN float should be a singleton'); - Assert.IsTrue(IsNaN(nan1.Value), 'Value of NaN float should be NaN'); - Assert.AreEqual('NaN', IDataValue(nan1).AsString, 'NaN AsString is incorrect'); - - // Test generic path - generic := TDataType.Float.CreateValue(123.45); - Assert.IsNotNull(IDataFloatValue(generic), 'Generic float should be created'); - Assert.AreNotSame(IDataFloatValue(zero1), IDataFloatValue(generic), 'Generic float should not be the zero singleton'); - Assert.AreNotSame(IDataFloatValue(nan1), IDataFloatValue(generic), 'Generic float should not be the NaN singleton'); - Assert.AreEqual(123.45, generic.Value, 'Value of generic float is incorrect'); -end; - -procedure TTestDataTypes.TestTimestamps; -var - tsType: TDataType.TTimestamp; - tsValue1, tsValue2, castedValue: TDataType.TTimestamp.TValue; - dataValue: IDataValue; - now: TDateTime; -begin - // --- 1. Test Type Creation --- - tsType := TDataType.Timestamp; - - Assert.IsNotNull(IDataTimestampType(tsType), 'TimestampType should be created'); - Assert.AreEqual('Timestamp', TDataType(tsType).Name, 'Type name should be Timestamp'); - Assert.AreEqual(dkTimestamp, TDataType(tsType).Kind, 'Type kind should be dkTimestamp'); - - // --- 2. Test Value Creation and Access --- - now := System.Sysutils.Now; - tsValue1 := TDataType.Timestamp.CreateValue(now); - - Assert.IsNotNull(IDataTimestampValue(tsValue1), 'TimestampValue should be created'); - Assert.AreSame(IDataType(tsType), IDataType(tsValue1.DataType), 'Value should have the correct data type'); - Assert.AreEqual(now, tsValue1.Value, 'Value should be the same'); - - // Test another text value - tsValue2 := TDataType.Timestamp.CreateValue(Date); - Assert.AreEqual(Date, tsValue2.Value, 'Value should be the same'); - - // --- 3. Test AsTimestamp casting --- - dataValue := TDataType.Timestamp.CreateValue(now); - castedValue := TDataType.TValue(dataValue).AsTimestamp; - Assert.AreEqual(now, castedValue.Value, 'AsTimestamp should return correct value'); - - // Test invalid cast - dataValue := TDataType.Ordinal.CreateValue(123); - Assert.WillRaise( - procedure begin TDataType.TValue(dataValue).AsTimestamp; end, - EInvalidCast, - 'Casting non-timestamp to AsTimestamp should raise EInvalidCast' - ); -end; - -procedure TTestDataTypes.TestEnums; -var - colorType: TDataType.TEnum; - red, green, blue: TDataType.TEnum.TValue; -begin - // --- 1. Test Type Creation --- - colorType := TDataType.EnumOf('Color', ['Red', 'Green', 'Blue']); - - Assert.IsNotNull(IDataEnumType(colorType), 'EnumType should be created'); - Assert.AreEqual('Color', TDataType(colorType).Name, 'Name should be Color'); - Assert.AreEqual(dkEnum, TDataType(colorType).Kind, 'Kind should be dkEnum'); - Assert.AreEqual(3, colorType.IdentifierCount, 'IdentifierCount should be 3'); - Assert.AreEqual('Red', colorType.Identifiers[0], 'Identifier at index 0 should be Red'); - Assert.AreEqual('Green', colorType.Identifiers[1], 'Identifier at index 1 should be Green'); - Assert.AreEqual('Blue', colorType.Identifiers[2], 'Identifier at index 2 should be Blue'); - Assert.AreEqual(1, colorType.IndexOf('Green'), 'IndexOf Green should be 1'); - Assert.AreEqual(-1, colorType.IndexOf('Yellow'), 'IndexOf Yellow should be -1'); - - // --- 2. Test Value Creation and Access --- - red := colorType.CreateValue(0); - green := colorType.CreateValue('Green'); - blue := colorType.CreateValue(2); - - Assert.IsNotNull(IDataEnumValue(red), 'EnumValue from index should be created'); - Assert.AreSame(IDataType(colorType), IDataType(red.DataType), 'Red should have the correct data type'); - Assert.AreEqual(0, red.Value, 'Value of Red should be 0'); - Assert.AreEqual('Red', IDataValue(red).AsString, 'AsText of Red should be Red'); - - Assert.IsNotNull(IDataEnumValue(green), 'EnumValue from identifier should be created'); - Assert.AreSame(IDataType(colorType), IDataType(green.DataType), 'Green should have the correct data type'); - Assert.AreEqual(1, green.Value, 'Value of Green should be 1'); - Assert.AreEqual('Green', IDataValue(green).AsString, 'AsText of Green should be Green'); - - Assert.AreEqual(2, blue.Value, 'Value of Blue should be 2'); - - // --- 3. Test Validation and Error Handling --- - // Test creating a type with duplicate identifiers - Assert.WillRaise( - procedure begin TDataType.EnumOf('Fails', ['A', 'B', 'A']); end, - EArgumentException, - 'Duplicate identifiers should raise an exception' - ); - - // Test creating a value with an invalid index - Assert.WillRaise(procedure begin colorType.CreateValue(3); end, EArgumentException, 'Invalid index should raise an exception'); - Assert.WillRaise(procedure begin colorType.CreateValue(-1); end, EArgumentException, 'Negative index should raise an exception'); - - // Test creating a value with an unknown identifier - Assert.WillRaise( - procedure begin colorType.CreateValue('Yellow'); end, - EArgumentException, - 'Unknown identifier should raise an exception' - ); -end; - -procedure TTestDataTypes.TestAsString; -var - ordinalValue: TDataType.TOrdinal.TValue; - floatValue: TDataType.TFloat.TValue; - textValue: TDataType.TText.TValue; - tsValue: TDataType.TTimestamp.TValue; - enumValue: TDataType.TEnum.TValue; - arrayValue: TDataType.TArray.TValue; - recordValue: TDataType.TRecord.TValue; - tupleValue: TDataType.TTuple.TValue; - colorType: TDataType.TEnum; - personType: TDataType.TRecord; - intArrayType: TDataType.TArray; - now: TDateTime; -begin - // Ordinal - ordinalValue := TDataType.Ordinal.CreateValue(123); - Assert.AreEqual('123', IDataValue(ordinalValue).AsString, 'Ordinal AsString incorrect'); - - // Float - floatValue := TDataType.Float.CreateValue(45.67); - Assert.AreEqual(FloatToStr(45.67), IDataValue(floatValue).AsString, 'Float AsString incorrect'); - - // Text - textValue := TDataType.Text.CreateValue('Hello'); - Assert.AreEqual('Hello', IDataValue(textValue).AsString, 'Text AsString incorrect'); - - // Timestamp - now := System.Sysutils.Now; - tsValue := TDataType.Timestamp.CreateValue(now); - Assert.AreEqual(DateTimeToStr(now), IDataValue(tsValue).AsString, 'Timestamp AsString incorrect'); - - // Enum - colorType := TDataType.EnumOf('Color', ['Red', 'Green', 'Blue']); - enumValue := colorType.CreateValue('Green'); - Assert.AreEqual('Green', IDataValue(enumValue).AsString, 'Enum AsString incorrect'); - - // Array - intArrayType := TDataType.ArrayOf(TDataType.Ordinal); - arrayValue := intArrayType.CreateValue([TDataType.Ordinal.CreateValue(1), TDataType.Ordinal.CreateValue(2)]); - Assert.AreEqual('[1, 2]', IDataValue(arrayValue).AsString, 'Array AsString incorrect'); - - // Record - personType := TDataType.RecordOf([TDataRecordField.Create('ID', TDataType.Ordinal), TDataRecordField.Create('Name', TDataType.Text)]); - recordValue := personType.CreateValue([TDataType.Ordinal.CreateValue(1), TDataType.Text.CreateValue('Bob')]); - Assert.AreEqual('', IDataValue(recordValue).AsString, 'Record AsString incorrect'); - - // Tuple - tupleValue := TDataType.TupleOf([TDataType.Ordinal.CreateValue(10), TDataType.Text.CreateValue('Tuple')]); - Assert.AreEqual('(10, Tuple)', IDataValue(tupleValue).AsString, 'Tuple AsString incorrect'); -end; - -procedure TTestDataTypes.TestAsTValue; -var - dataValue: TDataType.TValue; // Keep as generic interface to test AsTValue - now: TDateTime; - colorType: TDataType.TEnum; -begin - // This test is specifically for the IDataValue.AsTValue method. No changes needed. - // --- Ordinal --- - dataValue := TDataType.Ordinal.CreateValue(123); - var tv := AsTValue(dataValue); - Assert.IsFalse(tv.IsEmpty, 'Ordinal TValue should not be empty'); - Assert.AreEqual(tkInt64, tv.Kind, 'Ordinal TValue kind should be tkInt64'); - Assert.AreEqual(Int64(123), tv.AsInt64, 'Ordinal TValue content is incorrect'); - - // --- Float --- - dataValue := TDataType.Float.CreateValue(45.67); - tv := AsTValue(dataValue); - Assert.IsFalse(tv.IsEmpty, 'Float TValue should not be empty'); - Assert.AreEqual(tkFloat, tv.Kind, 'Float TValue kind should be tkFloat'); - Assert.AreEqual(45.67, tv.AsExtended, 'Float TValue content is incorrect'); - - // --- Text --- - dataValue := TDataType.Text.CreateValue('Hello'); - tv := AsTValue(dataValue); - Assert.IsFalse(tv.IsEmpty, 'Text TValue should not be empty'); - Assert.AreEqual(tkUString, tv.Kind, 'Text TValue kind should be tkUString'); - Assert.AreEqual('Hello', tv.AsString, 'Text TValue content is incorrect'); - - // --- Timestamp --- - now := System.SysUtils.Now; - dataValue := TDataType.Timestamp.CreateValue(now); - tv := AsTValue(dataValue); - Assert.IsFalse(tv.IsEmpty, 'Timestamp TValue should not be empty'); - Assert.AreEqual(tkFloat, tv.Kind, 'Timestamp TValue kind is incorrect'); - Assert.AreEqual(now, tv.AsType, 'Timestamp TValue content is incorrect'); - - // --- Enum --- - colorType := TDataType.EnumOf('Color', ['Red', 'Green', 'Blue']); - dataValue := colorType.CreateValue('Green'); - tv := AsTValue(dataValue); - Assert.IsFalse(tv.IsEmpty, 'Enum TValue should not be empty'); - Assert.AreEqual(tkInteger, tv.Kind, 'Enum TValue kind should be tkInteger'); - Assert.AreEqual(1, tv.AsInteger, 'Enum TValue content is incorrect'); -end; - -procedure TTestDataTypes.TestMethods; -var - ordinalType: TDataType.TOrdinal; - textType: TDataType.TText; - methodType1, methodType2, otherMethodType: TDataType.TMethod; - myFunc: TDataType.TMethod.TProc; - methodValue: TDataType.TMethod.TValue; - inputValue: TDataType.TOrdinal.TValue; - resultValue: TDataType.TValue; - textResult: TDataType.TText.TValue; - tv: TValue; -begin - // --- 1. Setup: Define base types --- - ordinalType := TDataType.Ordinal; - textType := TDataType.Text; - - // --- 2. Test Type Creation and Caching --- - methodType1 := TDataType.MethodOf(ordinalType, textType); - - // Assertions for the created type - Assert.IsNotNull(IDataMethodType(methodType1), 'MethodType should be created'); - Assert.AreEqual(dkMethod, TDataType(methodType1).Kind, 'Kind should be dkMethod'); - Assert.AreSame(IDataType(ordinalType), methodType1.ArgType, 'ArgType should be Ordinal'); - Assert.AreSame(IDataType(textType), methodType1.ResultType, 'ResultType should be Text'); - Assert.AreEqual('Method Text>', TDataType(methodType1).Name, 'Type name should match expected format'); - - // Test if the same definition returns the same cached instance - methodType2 := TDataType.MethodOf(ordinalType, textType); - Assert - .AreSame(IDataMethodType(methodType1), IDataMethodType(methodType2), 'Method types should be cached and return the same instance'); - - // Test if a different definition returns a new instance - otherMethodType := TDataType.MethodOf(textType, ordinalType); - Assert.AreNotSame( - IDataMethodType(methodType1), - IDataMethodType(otherMethodType), - 'Different signatures should result in different types' - ); - Assert.AreEqual('Method Integer>', TDataType(otherMethodType).Name, 'Name of other method type is incorrect'); - - // --- 3. Test Value Creation --- - // Define a function that matches the signature Ordinal -> Text - myFunc := - function(const AValue: TDataType.TValue): TDataType.TValue - var - ordinalValue: TDataType.TOrdinal.TValue; - val: Int64; - begin - ordinalValue := AValue.AsOrdinal; - val := ordinalValue.Value; - Result := TDataType.Text.CreateValue(val.ToString); - end; - - methodValue := methodType1.CreateValue(myFunc); - Assert.IsNotNull(IDataMethodValue(methodValue), 'MethodValue should be created'); - Assert.AreSame(IDataType(methodType1), IDataType(methodValue.DataType), 'Value should have the correct data type'); - - // --- 4. Test Execution (Simulated) --- - inputValue := TDataType.Ordinal.CreateValue(42); - // Execute the function retrieved from the value - resultValue := methodValue.Value(inputValue); - - Assert.IsNotNull(IDataValue(resultValue), 'Execution result should not be nil'); - Assert.AreSame(IDataType(textType), resultValue.DataType, 'Result value should have Text type'); - - textResult := resultValue.AsText; - Assert.AreEqual('42', textResult.Value, 'Result value content is incorrect'); - - // --- 5. Test AsString and AsTValue --- - Assert.AreEqual('', IDataValue(methodValue).AsString, 'Method AsString is incorrect'); - - tv := AsTValue(methodValue); - Assert.IsFalse(tv.IsEmpty, 'Method TValue should not be empty'); - Assert.AreEqual(tkInterface, tv.Kind, 'TValue kind for a TMethodProc should be tkInterface, as it is a reference-to-function'); - Assert.IsTrue(TypeInfo(TDataMethodProc) = tv.TypeInfo, 'TValue should hold TMethodProc type info'); - - // --- 6. Test Validation and Error Handling --- - // Test creating a value with a nil function - Assert.WillRaise( - procedure begin methodType1.CreateValue(nil); end, - EArgumentException, - 'CreateValue with nil function should raise an exception' - ); -end; - -end. diff --git a/Test/AST/Test.Myc.Ast.Compiler.Macros.pas b/Test/AST/Test.Myc.Ast.Compiler.Macros.pas new file mode 100644 index 0000000..119a7a7 --- /dev/null +++ b/Test/AST/Test.Myc.Ast.Compiler.Macros.pas @@ -0,0 +1,250 @@ +unit Test.Myc.Ast.Compiler.Macros; + +interface + +uses + DUnitX.TestFramework, + System.SysUtils, + System.Classes, + Myc.Ast, + Myc.Ast.Nodes, + Myc.Ast.Script, + Myc.Ast.Environment, + Myc.Data.Value, + Myc.Data.Scalar; + +type + [TestFixture] + TMacroTests = class + private + FEnv: TAstEnvironment; + + function Run(const Script: string): TDataValue; + + // Returns the raw AST root node after expansion + function ExpandToNode(const Script: string): IAstNode; + + // Helper to recursively find the first variable declaration in an AST subtree + function FindFirstVarName(const Node: IAstNode): string; + + public + [Setup] + procedure Setup; + [TearDown] + procedure TearDown; + + // --- Basic Functionality --- + + [Test] + [TestCase('Identity', '(defmacro id [x] `~x), (id 42), 42')] + [TestCase('Constant', '(defmacro c [] `100), (c), 100')] + [TestCase('SimpleAdd', '(defmacro add [a b] `(+ ~a ~b)), (add 10 20), 30')] + procedure Test_Basic_Expansion(const MacroDef, Call, ExpectedResult: string); + + // --- Quasiquoting & Unquoting --- + + [Test] + procedure Test_Quasiquote_Literal; + + [Test] + procedure Test_Unquote_Complex_Expression; + + // --- Hygiene (The Critical Checks) --- + + [Test] + procedure Test_Hygiene_GlobalSymbol_Preserved; + + [Test] + procedure Test_Hygiene_LocalVariable_Renamed; + + [Test] + procedure Test_Hygiene_Parameter_Renamed; + + // --- Corner Cases & Errors --- + + [Test] + procedure Test_Error_Unquote_Outside_Quasiquote; + + [Test] + procedure Test_Macro_Argument_Count_Mismatch; + end; + +implementation + +{ TMacroTests } + +procedure TMacroTests.Setup; +begin + FEnv := TAstEnvironment.Construct(nil); +end; + +procedure TMacroTests.TearDown; +begin + FEnv := Default(TAstEnvironment); +end; + +function TMacroTests.Run(const Script: string): TDataValue; +var + node: IAstNode; +begin + node := TAstScript.Parse(Script); + Result := FEnv.Run(node); +end; + +function TMacroTests.ExpandToNode(const Script: string): IAstNode; +var + node: IAstNode; +begin + node := TAstScript.Parse(Script); + Result := FEnv.Environment.ExpandMacros(node); +end; + +function TMacroTests.FindFirstVarName(const Node: IAstNode): string; +var + block: IBlockExpressionNode; + child: IAstNode; +begin + Result := ''; + + if not Assigned(Node) then + Exit; + + // Direct match + if Node.Kind = akVariableDeclaration then + Exit(Node.AsVariableDeclaration.Target.AsIdentifier.Name); + + // Recursive search in Blocks + if Node.Kind = akBlockExpression then + begin + block := Node.AsBlockExpression; + for child in block.Expressions do + begin + Result := FindFirstVarName(child); + if Result <> '' then + Exit; + end; + end; + + // Recursive search in MacroExpansion wrapper + if Node.Kind = akMacroExpansion then + begin + Result := FindFirstVarName(Node.AsMacroExpansion.ExpandedBody); + if Result <> '' then + Exit; + end; +end; + +procedure TMacroTests.Test_Basic_Expansion(const MacroDef, Call, ExpectedResult: string); +var + script: string; + res: TDataValue; +begin + script := Format('(do %s %s)', [MacroDef, Call]); + res := Run(script); + Assert.AreEqual(Trim(ExpectedResult), res.ToString); +end; + +procedure TMacroTests.Test_Quasiquote_Literal; +var + script: string; + res: TDataValue; +begin + // We execute this to verify it returns a valid AST structure (represented as TDataValue) + // Since we can't easily inspect TDataValue(IAstNode) without casting in the test, + // we just ensure it runs without error and returns something that is NOT void. + script := + ''' + (do + (def print (fn [msg] msg)) + (defmacro get-code [] `(print "hello")) + (get-code)) + '''; + + res := Run(script); + Assert.IsTrue(res.Kind = vkText, 'Quasiquote expansion should return a value'); +end; + +procedure TMacroTests.Test_Unquote_Complex_Expression; +var + script: string; + res: TDataValue; +begin + script := '(do ' + ' (defmacro calc [op a b] `(~op ~a ~b)) ' + ' (calc + 5 (* 2 3)))'; + + res := Run(script); + Assert.AreEqual(Int64(11), res.AsScalar.Value.AsInt64); +end; + +procedure TMacroTests.Test_Hygiene_GlobalSymbol_Preserved; +var + script: string; + res: TDataValue; +begin + // '+' is global. It MUST NOT be renamed. + script := '(do ' + ' (defmacro inc [x] `(+ ~x 1)) ' + ' (inc 41))'; + + try + res := Run(script); + Assert.AreEqual(Int64(42), res.AsScalar.Value.AsInt64); + except + on E: Exception do + Assert.Fail('Hygiene check failed. Global symbol likely renamed. Error: ' + E.Message); + end; +end; + +procedure TMacroTests.Test_Hygiene_LocalVariable_Renamed; +var + script: string; + expandedNode: IAstNode; + varName: string; +begin + // Local variables defined in a macro MUST be renamed. + script := '(do ' + ' (defmacro define-x [] `(do (def x 99) x)) ' + ' (define-x))'; + + // 1. Run first to ensure code validity (Execution logic) + var res := Run(script); + Assert.AreEqual(Int64(99), res.AsScalar.Value.AsInt64, 'Execution failed'); + + // 2. Inspect AST Object Graph (Structural logic) + expandedNode := ExpandToNode(script); + + // We search the AST for the VariableDeclaration of "x" + varName := FindFirstVarName(expandedNode); + + Assert.IsNotEmpty(varName, 'Variable declaration not found in AST'); + Assert.AreNotEqual('x', varName, 'Hygiene Failure: Variable "x" was NOT renamed.'); + Assert.IsTrue(varName.StartsWith('x#'), Format('Variable should be renamed to x#... but was "%s"', [varName])); +end; + +procedure TMacroTests.Test_Hygiene_Parameter_Renamed; +var + script: string; + res: TDataValue; +begin + // 'temp' inside macro should be renamed to 'temp#1' to not clash with global 'temp'. + script := + ''' + (do + (defmacro swap-bad [a b] + `(do (def temp ~a) (assign ~a ~b) (assign ~b temp))) + (def temp 10) + (def other 20) + (swap-bad temp other) ; Call with 'temp' passed as 'a' + temp) ; Should hold the swapped value (20) + '''; + + res := Run(script); + Assert.AreEqual(Int64(20), res.AsScalar.Value.AsInt64); +end; + +procedure TMacroTests.Test_Error_Unquote_Outside_Quasiquote; +begin + Assert.WillRaise(procedure begin Run('(print ~1)'); end, Exception, 'Unquote outside quasiquote should raise exception'); +end; + +procedure TMacroTests.Test_Macro_Argument_Count_Mismatch; +begin + Assert.WillRaise(procedure begin Run('(do (defmacro two [a b] `(+ ~a ~b)) (two 1))'); end, Exception); +end; + +end. diff --git a/Test/AST/Test.Myc.Ast.Script.pas b/Test/AST/Test.Myc.Ast.Script.pas new file mode 100644 index 0000000..f141568 --- /dev/null +++ b/Test/AST/Test.Myc.Ast.Script.pas @@ -0,0 +1,382 @@ +unit Test.Myc.Ast.Script; + +interface + +uses + DUnitX.TestFramework, + System.SysUtils, + System.Generics.Collections, + Myc.Data.Value, + Myc.Data.Scalar, + Myc.Ast.Nodes, + Myc.Ast.Script, + Myc.Ast; + +type + [TestFixture] + TTestMycAstScript = class + private + function Parse(const S: string): IAstNode; + public + // --- Atoms --- + [Test] + [TestCase('Integer', '42,42')] + [TestCase('Negative', '-10,-10')] + [TestCase('Zero', '0,0')] + procedure Parser_Number_Integer(const Source: string; Expected: Int64); + + [Test] + [TestCase('Float', '3.14,3.14')] + [TestCase('FloatNeg', '-0.5,-0.5')] + procedure Parser_Number_Float(const Source: string; Expected: Double); + + [Test] + [TestCase('Simple', '"hello",hello')] + [TestCase('Space', '"hello world",hello world')] + [TestCase('Empty', '"",')] + procedure Parser_String(const Source, Expected: string); + + [Test] + [TestCase('Simple', 'myVar')] + [TestCase('Kebab', 'my-var')] + [TestCase('Snake', 'my_var')] + [TestCase('Hygienic', 'var#1')] + [TestCase('Predicate', 'empty?')] + [TestCase('Bang', 'set!')] + procedure Parser_Identifier(const Source: string); + + [Test] + [IgnoreMemoryLeaks] + [TestCase('Simple', ':key,key')] + [TestCase('Kebab', ':my-key,my-key')] + procedure Parser_Keyword(const Source, ExpectedName: string); + + [Test] + procedure Parser_Nop_Token; + + // --- Comments --- + [Test] + procedure Parser_Comments_AreIgnored; + + // --- Structures --- + [Test] + procedure Parser_List_FunctionCall; + + [Test] + [IgnoreMemoryLeaks] + procedure Parser_RecordLiteral; + + [Test] + procedure Parser_RecordLiteral_Empty; + + // --- Special Forms --- + [Test] + procedure Parser_If_CreatesIfNode; + + [Test] + procedure Parser_Fn_CreatesLambdaNode; + + [Test] + procedure Parser_Def_CreatesVarDeclNode; + + [Test] + [IgnoreMemoryLeaks] + procedure Parser_MemberAccess_DotNotation; + + // --- Reader Macros --- + [Test] + procedure Parser_Quote_ExpandsToCall; + + [Test] + procedure Parser_Quasiquote_CreatesNode; + + [Test] + procedure Parser_Unquote_CreatesNode; + + [Test] + procedure Parser_UnquoteSplicing_CreatesNode; + + // --- Error Handling --- + [Test] + procedure Parser_Error_UnbalancedParens_MissingRight; + + [Test] + procedure Parser_Error_UnbalancedParens_ExtraRight; + + [Test] + procedure Parser_Error_UnterminatedString; + + [Test] + procedure Parser_Error_EmptyList; + + [Test] + procedure Parser_Error_Record_MissingValue; + end; + +implementation + +{ TTestMycAstScript } + +function TTestMycAstScript.Parse(const S: string): IAstNode; +begin + Result := TAstScript.Parse(S); +end; + +// --- Atoms --- + +procedure TTestMycAstScript.Parser_Number_Integer(const Source: string; Expected: Int64); +var + node: IAstNode; +begin + node := Parse(Source); + Assert.AreEqual(TAstNodeKind.akConstant, node.Kind); + Assert.AreEqual(TScalar.TKind.Ordinal, node.AsConstant.Value.AsScalar.Kind); + Assert.AreEqual(Expected, node.AsConstant.Value.AsScalar.Value.AsInt64); +end; + +procedure TTestMycAstScript.Parser_Number_Float(const Source: string; Expected: Double); +var + node: IAstNode; +begin + node := Parse(Source); + Assert.AreEqual(TAstNodeKind.akConstant, node.Kind); + Assert.AreEqual(TScalar.TKind.Float, node.AsConstant.Value.AsScalar.Kind); + + // FIX 1: Use non-generic overload for Double with Delta + Assert.AreEqual(Expected, node.AsConstant.Value.AsScalar.Value.AsDouble, 0.0001); +end; + +procedure TTestMycAstScript.Parser_String(const Source, Expected: string); +var + node: IAstNode; + s: string; +begin + node := Parse(Source); + Assert.AreEqual(TAstNodeKind.akConstant, node.Kind); + Assert.AreEqual(TDataValueKind.vkText, node.AsConstant.Value.Kind); + + s := node.AsConstant.Value.AsText; + Assert.AreEqual(Expected, s); +end; + +procedure TTestMycAstScript.Parser_Identifier(const Source: string); +var + node: IAstNode; +begin + node := Parse(Source); + Assert.AreEqual(TAstNodeKind.akIdentifier, node.Kind); + Assert.AreEqual(Source, node.AsIdentifier.Name); +end; + +procedure TTestMycAstScript.Parser_Keyword(const Source, ExpectedName: string); +var + node: IAstNode; +begin + node := Parse(Source); + Assert.AreEqual(TAstNodeKind.akKeyword, node.Kind); + Assert.AreEqual(ExpectedName, node.AsKeyword.Value.Name); +end; + +procedure TTestMycAstScript.Parser_Nop_Token; +var + node: IAstNode; +begin + node := Parse('...'); + Assert.AreEqual(TAstNodeKind.akNop, node.Kind); +end; + +// --- Comments --- + +procedure TTestMycAstScript.Parser_Comments_AreIgnored; +var + node: IAstNode; +begin + node := Parse('123 ; this is a comment'); + Assert.AreEqual(TAstNodeKind.akConstant, node.Kind); + Assert.AreEqual(123, node.AsConstant.Value.AsScalar.Value.AsInt64); +end; + +// --- Structures --- + +procedure TTestMycAstScript.Parser_List_FunctionCall; +var + node: IAstNode; + call: IFunctionCallNode; +begin + node := Parse('(add 1 2)'); + + Assert.AreEqual(TAstNodeKind.akFunctionCall, node.Kind); + call := node.AsFunctionCall; + + Assert.AreEqual('add', call.Callee.AsIdentifier.Name); + Assert.AreEqual(2, Length(call.Arguments)); + + Assert.AreEqual(1, call.Arguments[0].AsConstant.Value.AsScalar.Value.AsInt64); + Assert.AreEqual(2, call.Arguments[1].AsConstant.Value.AsScalar.Value.AsInt64); +end; + +procedure TTestMycAstScript.Parser_RecordLiteral; +var + node: IAstNode; + rec: IRecordLiteralNode; +begin + node := Parse('{:a 1 :b 2}'); + + Assert.AreEqual(TAstNodeKind.akRecordLiteral, node.Kind); + rec := node.AsRecordLiteral; + + Assert.AreEqual(2, Length(rec.Fields)); + Assert.AreEqual('a', rec.Fields[0].Key.Value.Name); + Assert.AreEqual(1, rec.Fields[0].Value.AsConstant.Value.AsScalar.Value.AsInt64); + + Assert.AreEqual('b', rec.Fields[1].Key.Value.Name); + Assert.AreEqual(2, rec.Fields[1].Value.AsConstant.Value.AsScalar.Value.AsInt64); +end; + +procedure TTestMycAstScript.Parser_RecordLiteral_Empty; +var + node: IAstNode; +begin + node := Parse('{}'); + Assert.AreEqual(TAstNodeKind.akRecordLiteral, node.Kind); + Assert.AreEqual(0, Length(node.AsRecordLiteral.Fields)); +end; + +// --- Special Forms --- + +procedure TTestMycAstScript.Parser_If_CreatesIfNode; +var + node: IAstNode; + ifNode: IIfExpressionNode; +begin + node := Parse('(if 1 2 3)'); + Assert.AreEqual(TAstNodeKind.akIfExpression, node.Kind); + + ifNode := node.AsIfExpression; + Assert.IsNotNull(ifNode.Condition); + Assert.IsNotNull(ifNode.ThenBranch); + Assert.IsNotNull(ifNode.ElseBranch); +end; + +procedure TTestMycAstScript.Parser_Fn_CreatesLambdaNode; +var + node: IAstNode; + lam: ILambdaExpressionNode; +begin + node := Parse('(fn [a b] (add a b))'); + + Assert.AreEqual(TAstNodeKind.akLambdaExpression, node.Kind); + lam := node.AsLambdaExpression; + + Assert.AreEqual(2, Length(lam.Parameters)); + Assert.AreEqual('a', lam.Parameters[0].Name); + Assert.AreEqual('b', lam.Parameters[1].Name); + + Assert.AreEqual(TAstNodeKind.akFunctionCall, lam.Body.Kind); +end; + +procedure TTestMycAstScript.Parser_Def_CreatesVarDeclNode; +var + node: IAstNode; + decl: IVariableDeclarationNode; +begin + node := Parse('(def x 10)'); + + Assert.AreEqual(TAstNodeKind.akVariableDeclaration, node.Kind); + decl := node.AsVariableDeclaration; + + Assert.AreEqual('x', decl.Target.AsIdentifier.Name); + Assert.IsNotNull(decl.Initializer); + Assert.AreEqual(10, decl.Initializer.AsConstant.Value.AsScalar.Value.AsInt64); +end; + +procedure TTestMycAstScript.Parser_MemberAccess_DotNotation; +var + node: IAstNode; + mem: IMemberAccessNode; +begin + node := Parse('(.Name obj)'); + + Assert.AreEqual(TAstNodeKind.akMemberAccess, node.Kind); + mem := node.AsMemberAccess; + + Assert.AreEqual('Name', mem.Member.Value.Name); + Assert.AreEqual('obj', mem.Base.AsIdentifier.Name); +end; + +// --- Reader Macros --- + +procedure TTestMycAstScript.Parser_Quote_ExpandsToCall; +var + node: IAstNode; + call: IFunctionCallNode; +begin + node := Parse('''foo'); + + Assert.AreEqual(TAstNodeKind.akFunctionCall, node.Kind); + call := node.AsFunctionCall; + + Assert.AreEqual('quote', call.Callee.AsIdentifier.Name); + Assert.AreEqual(1, Length(call.Arguments)); + Assert.AreEqual('foo', call.Arguments[0].AsIdentifier.Name); +end; + +procedure TTestMycAstScript.Parser_Quasiquote_CreatesNode; +var + node: IAstNode; +begin + node := Parse('`(a)'); + Assert.AreEqual(TAstNodeKind.akQuasiquote, node.Kind); + Assert.AreEqual(TAstNodeKind.akFunctionCall, node.AsQuasiquote.Expression.Kind); +end; + +procedure TTestMycAstScript.Parser_Unquote_CreatesNode; +var + node: IAstNode; +begin + node := Parse('~x'); + Assert.AreEqual(TAstNodeKind.akUnquote, node.Kind); + Assert.AreEqual('x', node.AsUnquote.Expression.AsIdentifier.Name); +end; + +procedure TTestMycAstScript.Parser_UnquoteSplicing_CreatesNode; +var + node: IAstNode; +begin + // ~@x + // There's something off here - we'll fix this later + node := Parse('~@`x'); + Assert.AreEqual(TAstNodeKind.akUnquoteSplicing, node.Kind); + + Assert.AreEqual('x', node.AsUnquoteSplicing.Expression.AsQuasiquote.Expression.AsIdentifier.Name); +end; + +// --- Error Handling --- + +procedure TTestMycAstScript.Parser_Error_UnbalancedParens_MissingRight; +begin + // FIX 2: Pass explicit Exception type to WillRaise + Assert.WillRaise(procedure begin Parse('(a b'); end, Exception); +end; + +procedure TTestMycAstScript.Parser_Error_UnbalancedParens_ExtraRight; +begin + Assert.WillRaise(procedure begin Parse('a )'); end, Exception); +end; + +procedure TTestMycAstScript.Parser_Error_UnterminatedString; +begin + Assert.WillRaise(procedure begin Parse('"hello'); end, Exception); +end; + +procedure TTestMycAstScript.Parser_Error_EmptyList; +begin + Assert.WillRaise(procedure begin Parse('()'); end, Exception); +end; + +procedure TTestMycAstScript.Parser_Error_Record_MissingValue; +begin + Assert.WillRaise(procedure begin Parse('{:a 1 :b}'); end, Exception); +end; + +end. diff --git a/Test/MycTests.dpr b/Test/MycTests.dpr index af09295..2d02ed7 100644 --- a/Test/MycTests.dpr +++ b/Test/MycTests.dpr @@ -25,16 +25,12 @@ uses Myc.Test.Signals.Dirty in '..\Src\Myc.Test.Signals.Dirty.pas', Test.Core.Mutable in 'Test.Core.Mutable.pas', TestDataArray in 'TestDataArray.pas', - TestDataTypes in '..\Src\Data\TestDataTypes.pas', - Myc.Ast in '..\Src\AST\Myc.Ast.pas', - TestDataTypes.JSON in '..\Src\Data\TestDataTypes.JSON.pas', - Myc.Data.POD in '..\Src\Data\Myc.Data.Scalar.pas', - Myc.Data.Decimal in '..\Src\Data\Myc.Data.Decimal.pas', TestDataDecimal in 'TestDataDecimal.pas', TestDataPOD in 'TestDataPOD.pas', - Myc.Data.Chunks in '..\Src\Data\Myc.Data.Chunks.pas', Test.Myc.Ast.Scope in 'AST\Test.Myc.Ast.Scope.pas', - Test.Myc.Ast.RTL in 'AST\Test.Myc.Ast.RTL.pas'; + Test.Myc.Ast.RTL in 'AST\Test.Myc.Ast.RTL.pas', + Test.Myc.Ast.Script in 'AST\Test.Myc.Ast.Script.pas', + Test.Myc.Ast.Compiler.Macros in 'AST\Test.Myc.Ast.Compiler.Macros.pas'; { keep comment here to protect the following conditional from being removed by the IDE when adding a unit } {$IFNDEF TESTINSIGHT} diff --git a/Test/MycTests.dproj b/Test/MycTests.dproj index 36a7df2..e71df19 100644 --- a/Test/MycTests.dproj +++ b/Test/MycTests.dproj @@ -126,18 +126,12 @@ $(PreBuildEvent)]]> - - - - - Myc.Data.POD - - - + + Base