MycLib/Test/AST/Test.Myc.Ast.Script.pas

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.