Tests for AST Binder
This commit is contained in:
Michael Schimmel
@@ -134,10 +134,11 @@ type
|
||||
private
|
||||
FParent: IScopeLayout;
|
||||
FMap: TDictionary<string, Integer>;
|
||||
FSlotCount: Integer; // Explicit slot count
|
||||
function GetParent: IScopeLayout;
|
||||
function GetSlotCount: Integer;
|
||||
public
|
||||
constructor Create(const AParent: IScopeLayout; AMap: TDictionary<string, Integer>);
|
||||
constructor Create(const AParent: IScopeLayout; AMap: TDictionary<string, Integer>; ASlotCount: Integer);
|
||||
destructor Destroy; override;
|
||||
function FindSlot(const Name: string): Integer;
|
||||
function GetSymbols: TArray<string>;
|
||||
@@ -148,6 +149,7 @@ type
|
||||
private
|
||||
FParentLayout: IScopeLayout;
|
||||
FMap: TDictionary<string, Integer>;
|
||||
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<string, Integer>);
|
||||
constructor TScopeLayout.Create(const AParent: IScopeLayout; AMap: TDictionary<string, Integer>; 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<string, Integer>.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<string, Integer>.Create(FMap));
|
||||
// Pass FNextSlot as the total slot count
|
||||
Result := TScopeLayout.Create(FParentLayout, TDictionary<string, Integer>.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<string, Integer>.Create);
|
||||
Result := TScopeLayout.Create(nil, TDictionary<string, Integer>.Create, 0);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@@ -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<Integer>(0, initIdent.Address.SlotIndex, 'Initializer should resolve to "a" (Slot 0).');
|
||||
Assert.AreEqual<Integer>(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<TAddressKind>(akLocalOrParent, ident.Address.Kind);
|
||||
Assert.AreEqual<Integer>(0, ident.Address.ScopeDepth);
|
||||
Assert.AreEqual<Integer>(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<Integer>(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<Integer>(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<Integer>(1, lambda.Parameters[0].Address.SlotIndex);
|
||||
Assert.AreEqual<Integer>(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<TAddressKind>(akUpvalue, bodyIdent.Address.Kind);
|
||||
Assert.AreEqual<Integer>(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<TAddressKind>(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('<self>'));
|
||||
bound := Unwrap(Bind(root, layout));
|
||||
lambda := bound.AsLambdaExpression;
|
||||
Assert.AreEqual<Integer>(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.
|
||||
+2
-1
@@ -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}
|
||||
|
||||
@@ -133,6 +133,7 @@ $(PreBuildEvent)]]></PreBuildEvent>
|
||||
<DCCReference Include="AST\Test.Myc.Ast.Script.pas"/>
|
||||
<DCCReference Include="AST\Test.Myc.Ast.Compiler.Macros.pas"/>
|
||||
<DCCReference Include="AST\Test.Myc.Ast.RTL.DateTime.pas"/>
|
||||
<DCCReference Include="..\Src\AST\Test.Myc.Ast.Compiler.Binder.pas"/>
|
||||
<BuildConfiguration Include="Base">
|
||||
<Key>Base</Key>
|
||||
</BuildConfiguration>
|
||||
|
||||
Reference in New Issue
Block a user