AST testing

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.