Ast editor unit refactoring
This commit is contained in:
Michael Schimmel
@@ -0,0 +1,369 @@
|
||||
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 (Length(Node.AsBlockExpression.Expressions) = 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;
|
||||
Assert.AreEqual<Integer>(1, lambda.Parameters[0].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;
|
||||
Assert.AreEqual<Integer>(1, lambda.Parameters[0].Address.SlotIndex);
|
||||
Assert.AreEqual<Integer>(2, lambda.Parameters[1].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.
|
||||
Reference in New Issue
Block a user