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); // Use Count instead of Length Assert.AreEqual(2, call.Arguments.Count); 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, rec.Fields.Count); // FIX: Cast elements to RecordField to access Key/Value Assert.AreEqual('a', rec.Fields[0].AsRecordField.Key.Value.Name); Assert.AreEqual(1, rec.Fields[0].AsRecordField.Value.AsConstant.Value.AsScalar.Value.AsInt64); Assert.AreEqual('b', rec.Fields[1].AsRecordField.Key.Value.Name); Assert.AreEqual(2, rec.Fields[1].AsRecordField.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, node.AsRecordLiteral.Fields.Count); 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, lam.Parameters.Count); // FIX: Cast tuple items to Identifier to access Name Assert.AreEqual('a', lam.Parameters[0].AsIdentifier.Name); Assert.AreEqual('b', lam.Parameters[1].AsIdentifier.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); // Base is an IAstNode, need cast to Identifier to check 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, call.Arguments.Count); 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 // Note: Parser requires backtick after ~@ currently due to cast in Myc.Ast.Script: // Result.Node := TAst.UnquoteSplicing(expr.Node.AsQuasiquote, startLoc); 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 Assert.WillRaise(procedure begin Parse('(a b'); end); end; procedure TTestMycAstScript.Parser_Error_UnbalancedParens_ExtraRight; begin Assert.WillRaise(procedure begin Parse('a )'); end); end; procedure TTestMycAstScript.Parser_Error_UnterminatedString; begin Assert.WillRaise(procedure begin Parse('"hello'); end); end; procedure TTestMycAstScript.Parser_Error_EmptyList; begin Assert.WillRaise(procedure begin Parse('()'); end); end; procedure TTestMycAstScript.Parser_Error_Record_MissingValue; begin Assert.WillRaise(procedure begin Parse('{:a 1 :b}'); end); end; end.