Michael Schimmel
372 lines
12 KiB
ObjectPascal
372 lines
12 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;
|
|
|
|
// Updated Bind helper: Returns log to allow assertions on errors
|
|
function Bind(const Node: IAstNode; out Layout: IScopeLayout; out Log: ICompilerLog): 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_LogsError(const Name: string);
|
|
|
|
[Test]
|
|
procedure Test_UnresolvedIdentifier_LogsError;
|
|
|
|
[Test]
|
|
[IgnoreMemoryLeaks]
|
|
procedure Test_RedefinitionInSameScope_LogsError;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Myc.Data.Value;
|
|
|
|
{ TTestAstBinder }
|
|
|
|
procedure TTestAstBinder.Setup;
|
|
begin
|
|
FRootLayout := TScope.CreateRootLayout;
|
|
end;
|
|
|
|
function TTestAstBinder.Bind(const Node: IAstNode; out Layout: IScopeLayout; out Log: ICompilerLog): IAstNode;
|
|
begin
|
|
Log := TCompilerLog.Create;
|
|
// TAstBinder.Bind now takes Log instead of raising exceptions
|
|
Result := TAstBinder.Bind(FRootLayout, Node, Layout, Log);
|
|
end;
|
|
|
|
function TTestAstBinder.Unwrap(const Node: IAstNode): IAstNode;
|
|
begin
|
|
if (Node.Kind = akBlockExpression) and (Node.AsBlockExpression.Expressions.Count = 1) then
|
|
Result := Node.AsBlockExpression.Expressions[0]
|
|
else
|
|
Result := Node;
|
|
end;
|
|
|
|
// ------------------------------------------------------------------------------------------------
|
|
// Fixed Test: Initializer Visibility
|
|
// ------------------------------------------------------------------------------------------------
|
|
|
|
procedure TTestAstBinder.Test_Initializer_CanSeeOuterScope_ButNotSelf;
|
|
var
|
|
root, bound: IAstNode;
|
|
layout: IScopeLayout;
|
|
block: IBlockExpressionNode;
|
|
decl: IVariableDeclarationNode;
|
|
initIdent: IIdentifierNode;
|
|
log: ICompilerLog;
|
|
begin
|
|
// (do (def a 10) (def b a))
|
|
root := TAst.Block([TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(10)), TAst.VarDecl(TAst.Identifier('b'), TAst.Identifier('a'))]);
|
|
|
|
bound := Bind(root, layout, log);
|
|
Assert.IsFalse(log.HasErrors, 'Binding should succeed without errors.');
|
|
|
|
block := bound.AsBlockExpression;
|
|
|
|
// Check definition of 'b'
|
|
decl := block.Expressions[1].AsVariableDeclaration;
|
|
initIdent := decl.Initializer.AsIdentifier;
|
|
|
|
// 'a' is Slot 0. 'b' is Slot 1.
|
|
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_LogsError;
|
|
var
|
|
root: IAstNode;
|
|
layout: IScopeLayout;
|
|
log: ICompilerLog;
|
|
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))]);
|
|
|
|
Bind(root, layout, log);
|
|
|
|
Assert.IsTrue(log.HasErrors, 'Binder must log error for redefinition.');
|
|
Assert.AreEqual('Variable "a" is already defined in this scope.', log.GetEntries[0].Message);
|
|
end;
|
|
|
|
// ------------------------------------------------------------------------------------------------
|
|
// Basic Scope & Definitions
|
|
// ------------------------------------------------------------------------------------------------
|
|
|
|
procedure TTestAstBinder.Test_DefineAndResolve_LocalVariable;
|
|
var
|
|
root, bound: IAstNode;
|
|
layout: IScopeLayout;
|
|
block: IBlockExpressionNode;
|
|
ident: IIdentifierNode;
|
|
log: ICompilerLog;
|
|
begin
|
|
root := TAst.Block([TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(42)), TAst.Identifier('a')]);
|
|
bound := Bind(root, layout, log);
|
|
|
|
Assert.IsFalse(log.HasErrors);
|
|
|
|
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;
|
|
log: ICompilerLog;
|
|
begin
|
|
root :=
|
|
TAst.Block([TAst.VarDecl(TAst.Identifier('x'), TAst.Constant(1)), TAst.LambdaExpr([TAst.Identifier('x')], TAst.Identifier('x'))]);
|
|
bound := Bind(root, layout, log);
|
|
|
|
Assert.IsFalse(log.HasErrors);
|
|
|
|
block := bound.AsBlockExpression;
|
|
innerLambda := block.Expressions[1].AsLambdaExpression;
|
|
innerUsage := innerLambda.Body.AsIdentifier;
|
|
Assert.AreEqual<Integer>(1, innerUsage.Address.SlotIndex); // Parameter x (Slot 1 because <self> is Slot 0)
|
|
end;
|
|
|
|
procedure TTestAstBinder.Test_ScopeIsolation_SiblingScopesCannotSeeEachOther;
|
|
var
|
|
root: IAstNode;
|
|
layout: IScopeLayout;
|
|
log: ICompilerLog;
|
|
begin
|
|
// (do (fn [] (def a 1)) a) -> 'a' is inside lambda, not visible outside
|
|
root := TAst.Block([TAst.LambdaExpr([], TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(1))), TAst.Identifier('a')]);
|
|
|
|
Bind(root, layout, log);
|
|
|
|
Assert.IsTrue(log.HasErrors, 'Sibling scope access should fail.');
|
|
Assert.IsTrue(log.GetEntries[0].Message.Contains('Undefined identifier'), 'Expected undefined identifier error.');
|
|
end;
|
|
|
|
// ------------------------------------------------------------------------------------------------
|
|
// Parameters
|
|
// ------------------------------------------------------------------------------------------------
|
|
|
|
procedure TTestAstBinder.Test_LambdaParameters_AreBoundToSlotsStartingAtOne;
|
|
var
|
|
root, bound: IAstNode;
|
|
layout: IScopeLayout;
|
|
lambda: ILambdaExpressionNode;
|
|
log: ICompilerLog;
|
|
begin
|
|
root := TAst.LambdaExpr([TAst.Identifier('p1')], TAst.Nop);
|
|
bound := Unwrap(Bind(root, layout, log));
|
|
|
|
Assert.IsFalse(log.HasErrors);
|
|
|
|
lambda := bound.AsLambdaExpression;
|
|
// FIX: Cast element to Identifier to access Address
|
|
Assert.AreEqual<Integer>(1, lambda.Parameters[0].AsIdentifier.Address.SlotIndex); // Slot 0 is reserved for <self>
|
|
end;
|
|
|
|
procedure TTestAstBinder.Test_MultipleParameters_AreBoundCorrectly;
|
|
var
|
|
root, bound: IAstNode;
|
|
layout: IScopeLayout;
|
|
lambda: ILambdaExpressionNode;
|
|
log: ICompilerLog;
|
|
begin
|
|
root := TAst.LambdaExpr([TAst.Identifier('a'), TAst.Identifier('b')], TAst.Nop);
|
|
bound := Unwrap(Bind(root, layout, log));
|
|
|
|
Assert.IsFalse(log.HasErrors);
|
|
|
|
lambda := bound.AsLambdaExpression;
|
|
// FIX: Cast elements to Identifier
|
|
Assert.AreEqual<Integer>(1, lambda.Parameters[0].AsIdentifier.Address.SlotIndex);
|
|
Assert.AreEqual<Integer>(2, lambda.Parameters[1].AsIdentifier.Address.SlotIndex);
|
|
end;
|
|
|
|
// ------------------------------------------------------------------------------------------------
|
|
// Upvalues / Closures
|
|
// ------------------------------------------------------------------------------------------------
|
|
|
|
procedure TTestAstBinder.Test_Capture_ImmediateParent;
|
|
var
|
|
root, bound: IAstNode;
|
|
layout: IScopeLayout;
|
|
block: IBlockExpressionNode;
|
|
lambda: ILambdaExpressionNode;
|
|
bodyIdent: IIdentifierNode;
|
|
log: ICompilerLog;
|
|
begin
|
|
root := TAst.Block([TAst.VarDecl(TAst.Identifier('x'), TAst.Constant(99)), TAst.LambdaExpr([], TAst.Identifier('x'))]);
|
|
bound := Bind(root, layout, log);
|
|
|
|
Assert.IsFalse(log.HasErrors);
|
|
|
|
block := bound.AsBlockExpression;
|
|
lambda := block.Expressions[1].AsLambdaExpression;
|
|
bodyIdent := lambda.Body.AsIdentifier;
|
|
|
|
// Inside the lambda, 'x' is accessed via an Upvalue
|
|
Assert.AreEqual<TAddressKind>(akUpvalue, bodyIdent.Address.Kind);
|
|
Assert.AreEqual<Integer>(0, bodyIdent.Address.SlotIndex); // First captured value
|
|
end;
|
|
|
|
procedure TTestAstBinder.Test_Capture_GrandParent_PropagatesThroughIntermediateScope;
|
|
var
|
|
root, bound: IAstNode;
|
|
layout: IScopeLayout;
|
|
outerBlock: IBlockExpressionNode;
|
|
midLambda, innerLambda: ILambdaExpressionNode;
|
|
log: ICompilerLog;
|
|
begin
|
|
root :=
|
|
TAst.Block(
|
|
[TAst.VarDecl(TAst.Identifier('top'), TAst.Constant(100)), TAst.LambdaExpr([], TAst.LambdaExpr([], TAst.Identifier('top')))]
|
|
);
|
|
bound := Bind(root, layout, log);
|
|
|
|
Assert.IsFalse(log.HasErrors);
|
|
|
|
outerBlock := bound.AsBlockExpression;
|
|
midLambda := outerBlock.Expressions[1].AsLambdaExpression;
|
|
innerLambda := midLambda.Body.AsLambdaExpression;
|
|
|
|
// Inner lambda accesses 'top' via upvalue
|
|
Assert.AreEqual<TAddressKind>(akUpvalue, innerLambda.Body.AsIdentifier.Address.Kind);
|
|
end;
|
|
|
|
procedure TTestAstBinder.Test_Self_IsImplicitlyDefinedInLambda;
|
|
var
|
|
root, bound: IAstNode;
|
|
layout: IScopeLayout;
|
|
lambda: ILambdaExpressionNode;
|
|
log: ICompilerLog;
|
|
begin
|
|
root := TAst.LambdaExpr([], TAst.Identifier('<self>'));
|
|
bound := Unwrap(Bind(root, layout, log));
|
|
|
|
Assert.IsFalse(log.HasErrors);
|
|
|
|
lambda := bound.AsLambdaExpression;
|
|
// <self> is always at Slot 0 (Local)
|
|
Assert.AreEqual<TAddressKind>(akLocalOrParent, lambda.Body.AsIdentifier.Address.Kind);
|
|
Assert.AreEqual<Integer>(0, lambda.Body.AsIdentifier.Address.SlotIndex);
|
|
end;
|
|
|
|
// ------------------------------------------------------------------------------------------------
|
|
// Validation Tests
|
|
// ------------------------------------------------------------------------------------------------
|
|
|
|
procedure TTestAstBinder.Test_IdentifierValidation_ValidNames(const Name: string);
|
|
var
|
|
root: IAstNode;
|
|
layout: IScopeLayout;
|
|
log: ICompilerLog;
|
|
begin
|
|
root := TAst.VarDecl(TAst.Identifier(Name), nil);
|
|
Bind(root, layout, log);
|
|
Assert.IsFalse(log.HasErrors, 'Valid name should not produce errors.');
|
|
end;
|
|
|
|
procedure TTestAstBinder.Test_IdentifierValidation_InvalidNames_LogsError(const Name: string);
|
|
var
|
|
root: IAstNode;
|
|
layout: IScopeLayout;
|
|
log: ICompilerLog;
|
|
begin
|
|
root := TAst.VarDecl(TAst.Identifier(Name), nil);
|
|
Bind(root, layout, log);
|
|
|
|
Assert.IsTrue(log.HasErrors, 'Invalid name should produce error.');
|
|
Assert.IsTrue(log.GetEntries[0].Message.Contains('Invalid identifier name'));
|
|
end;
|
|
|
|
procedure TTestAstBinder.Test_UnresolvedIdentifier_LogsError;
|
|
var
|
|
root: IAstNode;
|
|
layout: IScopeLayout;
|
|
log: ICompilerLog;
|
|
begin
|
|
root := TAst.Identifier('z');
|
|
Bind(root, layout, log);
|
|
|
|
Assert.IsTrue(log.HasErrors, 'Unresolved identifier should produce error.');
|
|
Assert.IsTrue(log.GetEntries[0].Message.Contains('Undefined identifier'));
|
|
end;
|
|
|
|
end.
|