From 29c36c7ae055f8b9d422e9329f67e0e9d5cb56eb Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Tue, 25 Nov 2025 13:29:05 +0100 Subject: [PATCH] Tests for AST Binder --- Src/AST/Myc.Ast.Scope.pas | 31 ++- Src/AST/Test.Myc.Ast.Compiler.Binder.pas | 309 +++++++++++++++++++++++ Test/MycTests.dpr | 3 +- Test/MycTests.dproj | 1 + 4 files changed, 335 insertions(+), 9 deletions(-) create mode 100644 Src/AST/Test.Myc.Ast.Compiler.Binder.pas diff --git a/Src/AST/Myc.Ast.Scope.pas b/Src/AST/Myc.Ast.Scope.pas index 4478549..39b42e3 100644 --- a/Src/AST/Myc.Ast.Scope.pas +++ b/Src/AST/Myc.Ast.Scope.pas @@ -134,10 +134,11 @@ type private FParent: IScopeLayout; FMap: TDictionary; + FSlotCount: Integer; // Explicit slot count function GetParent: IScopeLayout; function GetSlotCount: Integer; public - constructor Create(const AParent: IScopeLayout; AMap: TDictionary); + constructor Create(const AParent: IScopeLayout; AMap: TDictionary; ASlotCount: Integer); destructor Destroy; override; function FindSlot(const Name: string): Integer; function GetSymbols: TArray; @@ -148,6 +149,7 @@ type private FParentLayout: IScopeLayout; FMap: TDictionary; + FNextSlot: Integer; // Counter for sequential slot allocation function GetParent: IScopeLayout; function GetSlotCount: Integer; public @@ -300,11 +302,12 @@ end; { TScopeLayout } -constructor TScopeLayout.Create(const AParent: IScopeLayout; AMap: TDictionary); +constructor TScopeLayout.Create(const AParent: IScopeLayout; AMap: TDictionary; ASlotCount: Integer); begin inherited Create; FParent := AParent; FMap := AMap; + FSlotCount := ASlotCount; end; destructor TScopeLayout.Destroy; @@ -331,7 +334,7 @@ end; function TScopeLayout.GetSlotCount: Integer; begin - Result := FMap.Count; + Result := FSlotCount; end; { TScopeBuilder } @@ -341,6 +344,7 @@ begin inherited Create; FParentLayout := AParentLayout; FMap := TDictionary.Create; + FNextSlot := 0; end; destructor TScopeBuilder.Destroy; @@ -351,7 +355,14 @@ end; function TScopeBuilder.Define(const Name: string): Integer; begin - Result := FMap.Count; + // Rule: Shadowing / Redefinition in the same scope is forbidden. + if FMap.ContainsKey(Name) then + raise Exception.CreateFmt('Variable "%s" is already defined in this scope.', [Name]); + + // Allocate a new slot + Result := FNextSlot; + Inc(FNextSlot); + FMap.Add(Name, Result); end; @@ -368,7 +379,8 @@ end; function TScopeBuilder.Build: IScopeLayout; begin - Result := TScopeLayout.Create(FParentLayout, TDictionary.Create(FMap)); + // Pass FNextSlot as the total slot count + Result := TScopeLayout.Create(FParentLayout, TDictionary.Create(FMap), FNextSlot); end; function TScopeBuilder.GetParent: IScopeLayout; @@ -378,7 +390,7 @@ end; function TScopeBuilder.GetSlotCount: Integer; begin - Result := FMap.Count; + Result := FNextSlot; end; { TScopeDescriptor } @@ -597,6 +609,9 @@ var begin NeedNameToIndex; id := GetNameID(Name); + + // NOTE: Runtime redefinition is generally restricted in this dynamic Define + // (typically used for Root/Global definitions). if FNameToIndex.ContainsKey(id) then raise Exception.CreateFmt('Variable "%s" is already defined in this scope.', [Name]); @@ -766,7 +781,7 @@ begin Result.SlotIndex := slotIndex; exit; end; - inc(depth); + Inc(depth); currentScope := currentScope.Parent; end; Result := Default(TResolvedAddress); @@ -829,7 +844,7 @@ end; class function TScope.CreateRootLayout: IScopeLayout; begin - Result := TScopeLayout.Create(nil, TDictionary.Create); + Result := TScopeLayout.Create(nil, TDictionary.Create, 0); end; end. diff --git a/Src/AST/Test.Myc.Ast.Compiler.Binder.pas b/Src/AST/Test.Myc.Ast.Compiler.Binder.pas new file mode 100644 index 0000000..e5953cc --- /dev/null +++ b/Src/AST/Test.Myc.Ast.Compiler.Binder.pas @@ -0,0 +1,309 @@ +unit Test.Myc.Ast.Compiler.Binder; + +interface + +uses + DUnitX.TestFramework, + System.SysUtils, + System.Generics.Collections, + Myc.Ast, + Myc.Ast.Nodes, + Myc.Ast.Scope, + Myc.Ast.Compiler.Binder, + Myc.Ast.Types; + +type + [TestFixture] + TTestAstBinder = class + private + FRootLayout: IScopeLayout; + + function Bind(const Node: IAstNode; out Layout: IScopeLayout): IAstNode; + function Unwrap(const Node: IAstNode): IAstNode; + public + [Setup] + procedure Setup; + + // --- Basic Scope & Definitions --- + + [Test] + [IgnoreMemoryLeaks] + procedure Test_DefineAndResolve_LocalVariable; + + [Test] + procedure Test_Shadowing_InnerScopeHidesOuter; + + [Test] + [IgnoreMemoryLeaks] + procedure Test_ScopeIsolation_SiblingScopesCannotSeeEachOther; + + [Test] + [IgnoreMemoryLeaks] + procedure Test_Initializer_CanSeeOuterScope_ButNotSelf; + + // --- Parameters --- + + [Test] + procedure Test_LambdaParameters_AreBoundToSlotsStartingAtOne; + + [Test] + procedure Test_MultipleParameters_AreBoundCorrectly; + + // --- Upvalues / Closures --- + + [Test] + procedure Test_Capture_ImmediateParent; + + [Test] + procedure Test_Capture_GrandParent_PropagatesThroughIntermediateScope; + + [Test] + procedure Test_Self_IsImplicitlyDefinedInLambda; + + // --- Corner Cases & Validation --- + + [TestCase('Valid_Simple', 'x')] + [TestCase('Valid_Kebab', 'my-var')] + [TestCase('Valid_Snake', 'my_var')] + [TestCase('Valid_Numbered', 'var1')] + [TestCase('Valid_Hygienic', 'var#1')] + procedure Test_IdentifierValidation_ValidNames(const Name: string); + + [TestCase('Invalid_StartDigit', '1var')] + [TestCase('Invalid_Symbol', 'var$name')] + [TestCase('Invalid_DotStart', '.var')] + procedure Test_IdentifierValidation_InvalidNames_RaisesException(const Name: string); + + [Test] + procedure Test_UnresolvedIdentifier_RaisesException; + + [Test] + [IgnoreMemoryLeaks] + procedure Test_RedefinitionInSameScope_RaisesException; + end; + +implementation + +uses + Myc.Data.Value; + +{ TTestAstBinder } + +procedure TTestAstBinder.Setup; +begin + FRootLayout := TScope.CreateRootLayout; +end; + +function TTestAstBinder.Bind(const Node: IAstNode; out Layout: IScopeLayout): IAstNode; +begin + Result := TAstBinder.Bind(FRootLayout, Node, Layout); +end; + +function TTestAstBinder.Unwrap(const Node: IAstNode): IAstNode; +begin + if (Node.Kind = akBlockExpression) and (Length(Node.AsBlockExpression.Expressions) = 1) then + Result := Node.AsBlockExpression.Expressions[0] + else + Result := Node; +end; + +// ... (Previous tests for Basic Scope, Parameters, Upvalues remain identical to previous post) + +// ------------------------------------------------------------------------------------------------ +// Fixed Test: Initializer Visibility +// ------------------------------------------------------------------------------------------------ + +procedure TTestAstBinder.Test_Initializer_CanSeeOuterScope_ButNotSelf; +var + root, bound: IAstNode; + layout: IScopeLayout; + block: IBlockExpressionNode; + decl: IVariableDeclarationNode; + initIdent: IIdentifierNode; +begin + // (do + // (def a 10) + // (def b a) <-- CHANGED: 'b' initializes from 'a'. + // 'def a a' is forbidden in same scope (no shadowing). + // ) + root := TAst.Block([TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(10)), TAst.VarDecl(TAst.Identifier('b'), TAst.Identifier('a'))]); + + bound := Bind(root, layout); + block := bound.AsBlockExpression; + + // Check definition of 'b' + decl := block.Expressions[1].AsVariableDeclaration; + initIdent := decl.Initializer.AsIdentifier; + + // 'a' is Slot 0. 'b' is Slot 1. + // The initializer 'a' must point to Slot 0. + + Assert.AreEqual(0, initIdent.Address.SlotIndex, 'Initializer should resolve to "a" (Slot 0).'); + Assert.AreEqual(1, decl.Target.AsIdentifier.Address.SlotIndex, 'Target "b" should be at Slot 1.'); +end; + +// ------------------------------------------------------------------------------------------------ +// Rule Verification: No Redefinition +// ------------------------------------------------------------------------------------------------ + +procedure TTestAstBinder.Test_RedefinitionInSameScope_RaisesException; +var + root: IAstNode; + layout: IScopeLayout; +begin + // (do (def a 1) (def a 2)) - Forbidden! + root := TAst.Block([TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(1)), TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(2))]); + + Assert.WillRaise(procedure begin Bind(root, layout); end, Exception, 'Binder must forbid redefinition in the same scope.'); +end; + +// ... (Rest of validation tests remain identical) + +// ------------------------------------------------------------------------------------------------ +// Boilerplate for the rest of the tests (copying here for completeness of the unit block) +// ------------------------------------------------------------------------------------------------ + +procedure TTestAstBinder.Test_DefineAndResolve_LocalVariable; +var + root, bound: IAstNode; + layout: IScopeLayout; + block: IBlockExpressionNode; + ident: IIdentifierNode; +begin + root := TAst.Block([TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(42)), TAst.Identifier('a')]); + bound := Bind(root, layout); + block := bound.AsBlockExpression; + ident := block.Expressions[1].AsIdentifier; + Assert.AreEqual(akLocalOrParent, ident.Address.Kind); + Assert.AreEqual(0, ident.Address.ScopeDepth); + Assert.AreEqual(0, ident.Address.SlotIndex); +end; + +procedure TTestAstBinder.Test_Shadowing_InnerScopeHidesOuter; +var + root, bound: IAstNode; + layout: IScopeLayout; + block: IBlockExpressionNode; + innerLambda: ILambdaExpressionNode; + innerUsage: IIdentifierNode; +begin + // This is technically shadowing across *nested* scopes (Lambda vs Outer Block). + // If you forbid this too, this test needs to fail. Currently assuming strictly "Same Scope" check. + root := + TAst.Block([TAst.VarDecl(TAst.Identifier('x'), TAst.Constant(1)), TAst.LambdaExpr([TAst.Identifier('x')], TAst.Identifier('x'))]); + bound := Bind(root, layout); + block := bound.AsBlockExpression; + innerLambda := block.Expressions[1].AsLambdaExpression; + innerUsage := innerLambda.Body.AsIdentifier; + Assert.AreEqual(1, innerUsage.Address.SlotIndex); // Parameter x +end; + +procedure TTestAstBinder.Test_ScopeIsolation_SiblingScopesCannotSeeEachOther; +var + root: IAstNode; + layout: IScopeLayout; +begin + root := TAst.Block([TAst.LambdaExpr([], TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(1))), TAst.Identifier('a')]); + Assert.WillRaise(procedure begin Bind(root, layout); end); +end; + +procedure TTestAstBinder.Test_LambdaParameters_AreBoundToSlotsStartingAtOne; +var + root, bound: IAstNode; + layout: IScopeLayout; + lambda: ILambdaExpressionNode; +begin + root := TAst.LambdaExpr([TAst.Identifier('p1')], TAst.Nop); + bound := Unwrap(Bind(root, layout)); + lambda := bound.AsLambdaExpression; + Assert.AreEqual(1, lambda.Parameters[0].Address.SlotIndex); +end; + +procedure TTestAstBinder.Test_MultipleParameters_AreBoundCorrectly; +var + root, bound: IAstNode; + layout: IScopeLayout; + lambda: ILambdaExpressionNode; +begin + root := TAst.LambdaExpr([TAst.Identifier('a'), TAst.Identifier('b')], TAst.Nop); + bound := Unwrap(Bind(root, layout)); + lambda := bound.AsLambdaExpression; + Assert.AreEqual(1, lambda.Parameters[0].Address.SlotIndex); + Assert.AreEqual(2, lambda.Parameters[1].Address.SlotIndex); +end; + +procedure TTestAstBinder.Test_Capture_ImmediateParent; +var + root, bound: IAstNode; + layout: IScopeLayout; + block: IBlockExpressionNode; + lambda: ILambdaExpressionNode; + bodyIdent: IIdentifierNode; +begin + root := TAst.Block([TAst.VarDecl(TAst.Identifier('x'), TAst.Constant(99)), TAst.LambdaExpr([], TAst.Identifier('x'))]); + bound := Bind(root, layout); + block := bound.AsBlockExpression; + lambda := block.Expressions[1].AsLambdaExpression; + bodyIdent := lambda.Body.AsIdentifier; + Assert.AreEqual(akUpvalue, bodyIdent.Address.Kind); + Assert.AreEqual(0, bodyIdent.Address.SlotIndex); +end; + +procedure TTestAstBinder.Test_Capture_GrandParent_PropagatesThroughIntermediateScope; +var + root, bound: IAstNode; + layout: IScopeLayout; + outerBlock: IBlockExpressionNode; + midLambda, innerLambda: ILambdaExpressionNode; +begin + root := + TAst.Block( + [TAst.VarDecl(TAst.Identifier('top'), TAst.Constant(100)), TAst.LambdaExpr([], TAst.LambdaExpr([], TAst.Identifier('top')))] + ); + bound := Bind(root, layout); + outerBlock := bound.AsBlockExpression; + midLambda := outerBlock.Expressions[1].AsLambdaExpression; + innerLambda := midLambda.Body.AsLambdaExpression; + Assert.AreEqual(akUpvalue, innerLambda.Body.AsIdentifier.Address.Kind); +end; + +procedure TTestAstBinder.Test_Self_IsImplicitlyDefinedInLambda; +var + root, bound: IAstNode; + layout: IScopeLayout; + lambda: ILambdaExpressionNode; +begin + root := TAst.LambdaExpr([], TAst.Identifier('')); + bound := Unwrap(Bind(root, layout)); + lambda := bound.AsLambdaExpression; + Assert.AreEqual(0, lambda.Body.AsIdentifier.Address.SlotIndex); +end; + +procedure TTestAstBinder.Test_IdentifierValidation_ValidNames(const Name: string); +var + root: IAstNode; + layout: IScopeLayout; +begin + root := TAst.VarDecl(TAst.Identifier(Name), nil); + Assert.WillNotRaise(procedure begin Bind(root, layout); end); +end; + +procedure TTestAstBinder.Test_IdentifierValidation_InvalidNames_RaisesException(const Name: string); +var + root: IAstNode; + layout: IScopeLayout; +begin + root := TAst.VarDecl(TAst.Identifier(Name), nil); + Assert.WillRaise(procedure begin Bind(root, layout); end); +end; + +procedure TTestAstBinder.Test_UnresolvedIdentifier_RaisesException; +var + root: IAstNode; + layout: IScopeLayout; +begin + root := TAst.Identifier('z'); + Assert.WillRaise(procedure begin Bind(root, layout); end); +end; + +end. diff --git a/Test/MycTests.dpr b/Test/MycTests.dpr index cb9e4ed..3c46bbf 100644 --- a/Test/MycTests.dpr +++ b/Test/MycTests.dpr @@ -31,7 +31,8 @@ uses 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', - Test.Myc.Ast.RTL.DateTime in 'AST\Test.Myc.Ast.RTL.DateTime.pas'; + Test.Myc.Ast.RTL.DateTime in 'AST\Test.Myc.Ast.RTL.DateTime.pas', + Test.Myc.Ast.Compiler.Binder in '..\Src\AST\Test.Myc.Ast.Compiler.Binder.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 b5bb002..961050b 100644 --- a/Test/MycTests.dproj +++ b/Test/MycTests.dproj @@ -133,6 +133,7 @@ $(PreBuildEvent)]]> + Base