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.

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>(TAstNodeKind.akConstant, node.Kind);
+    Assert.AreEqual<TScalar.TKind>(TScalar.TKind.Ordinal, node.AsConstant.Value.AsScalar.Kind);
+    Assert.AreEqual<Int64>(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>(TAstNodeKind.akConstant, node.Kind);
+    Assert.AreEqual<TScalar.TKind>(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>(TAstNodeKind.akConstant, node.Kind);
+    Assert.AreEqual<TDataValueKind>(TDataValueKind.vkText, node.AsConstant.Value.Kind);
+
+    s := node.AsConstant.Value.AsText;
+    Assert.AreEqual<string>(Expected, s);
+end;
+
+procedure TTestMycAstScript.Parser_Identifier(const Source: string);
+var
+    node: IAstNode;
+begin
+    node := Parse(Source);
+    Assert.AreEqual<TAstNodeKind>(TAstNodeKind.akIdentifier, node.Kind);
+    Assert.AreEqual<string>(Source, node.AsIdentifier.Name);
+end;
+
+procedure TTestMycAstScript.Parser_Keyword(const Source, ExpectedName: string);
+var
+    node: IAstNode;
+begin
+    node := Parse(Source);
+    Assert.AreEqual<TAstNodeKind>(TAstNodeKind.akKeyword, node.Kind);
+    Assert.AreEqual<string>(ExpectedName, node.AsKeyword.Value.Name);
+end;
+
+procedure TTestMycAstScript.Parser_Nop_Token;
+var
+    node: IAstNode;
+begin
+    node := Parse('...');
+    Assert.AreEqual<TAstNodeKind>(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>(TAstNodeKind.akConstant, node.Kind);
+    Assert.AreEqual<Int64>(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>(TAstNodeKind.akFunctionCall, node.Kind);
+    call := node.AsFunctionCall;
+
+    Assert.AreEqual<string>('add', call.Callee.AsIdentifier.Name);
+    Assert.AreEqual<Integer>(2, Length(call.Arguments));
+
+    Assert.AreEqual<Int64>(1, call.Arguments[0].AsConstant.Value.AsScalar.Value.AsInt64);
+    Assert.AreEqual<Int64>(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>(TAstNodeKind.akRecordLiteral, node.Kind);
+    rec := node.AsRecordLiteral;
+
+    Assert.AreEqual<Integer>(2, Length(rec.Fields));
+    Assert.AreEqual<string>('a', rec.Fields[0].Key.Value.Name);
+    Assert.AreEqual<Int64>(1, rec.Fields[0].Value.AsConstant.Value.AsScalar.Value.AsInt64);
+
+    Assert.AreEqual<string>('b', rec.Fields[1].Key.Value.Name);
+    Assert.AreEqual<Int64>(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>(TAstNodeKind.akRecordLiteral, node.Kind);
+    Assert.AreEqual<Integer>(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>(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>(TAstNodeKind.akLambdaExpression, node.Kind);
+    lam := node.AsLambdaExpression;
+
+    Assert.AreEqual<Integer>(2, Length(lam.Parameters));
+    Assert.AreEqual<string>('a', lam.Parameters[0].Name);
+    Assert.AreEqual<string>('b', lam.Parameters[1].Name);
+
+    Assert.AreEqual<TAstNodeKind>(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>(TAstNodeKind.akVariableDeclaration, node.Kind);
+    decl := node.AsVariableDeclaration;
+
+    Assert.AreEqual<string>('x', decl.Target.AsIdentifier.Name);
+    Assert.IsNotNull(decl.Initializer);
+    Assert.AreEqual<Int64>(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>(TAstNodeKind.akMemberAccess, node.Kind);
+    mem := node.AsMemberAccess;
+
+    Assert.AreEqual<string>('Name', mem.Member.Value.Name);
+    Assert.AreEqual<string>('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>(TAstNodeKind.akFunctionCall, node.Kind);
+    call := node.AsFunctionCall;
+
+    Assert.AreEqual<string>('quote', call.Callee.AsIdentifier.Name);
+    Assert.AreEqual<Integer>(1, Length(call.Arguments));
+    Assert.AreEqual<string>('foo', call.Arguments[0].AsIdentifier.Name);
+end;
+
+procedure TTestMycAstScript.Parser_Quasiquote_CreatesNode;
+var
+    node: IAstNode;
+begin
+    node := Parse('`(a)');
+    Assert.AreEqual<TAstNodeKind>(TAstNodeKind.akQuasiquote, node.Kind);
+    Assert.AreEqual<TAstNodeKind>(TAstNodeKind.akFunctionCall, node.AsQuasiquote.Expression.Kind);
+end;
+
+procedure TTestMycAstScript.Parser_Unquote_CreatesNode;
+var
+    node: IAstNode;
+begin
+    node := Parse('~x');
+    Assert.AreEqual<TAstNodeKind>(TAstNodeKind.akUnquote, node.Kind);
+    Assert.AreEqual<string>('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>(TAstNodeKind.akUnquoteSplicing, node.Kind);
+
+    Assert.AreEqual<string>('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.