Michael Schimmel
310 lines
10 KiB
ObjectPascal
310 lines
10 KiB
ObjectPascal
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.
|