Files
MycLib/Test/Test.Ast.Interpreter.Scope.pas
T
Michael Schimmel d12c6c966c Fix in Upvalue-Logic
2025-09-18 20:11:12 +02:00

235 lines
8.7 KiB
ObjectPascal

unit Test.Ast.Interpreter.Scope;
interface
uses
Myc.Ast,
Myc.Ast.Nodes,
Myc.Ast.Binding,
Myc.Ast.Evaluator,
Myc.Ast.Scope,
Myc.Data.Scalar,
Myc.Data.Value,
DUnitX.TestFramework;
type
[TestFixture]
TInterpreterScopeTests = class(TObject)
private
FGlobalScope: IExecutionScope;
function Execute(const ANode: IAstNode): TDataValue;
public
[Setup]
procedure Setup;
[TearDown]
procedure TearDown;
[Test]
procedure Test_DeeplyNestedLambda_ModifiesUpvalue;
[Test]
procedure Test_SeparateClosures_ShareSameUpvalue;
[Test]
procedure Test_NestedLambda_CapturesParameter;
[Test]
procedure Test_VariableShadowing_DoesNotAffectUpvalue;
[Test]
procedure Test_CaptureFromGlobalScope;
end;
implementation
{ TInterpreterScopeTests }
function TInterpreterScopeTests.Execute(const ANode: IAstNode): TDataValue;
var
boundScope: IExecutionScope;
visitor: IAstVisitor;
begin
// Helper to encapsulate the Bind -> CreateScope -> Evaluate pattern.
boundScope := TAstBinder.Bind(ANode, FGlobalScope).CreateScope(FGlobalScope);
visitor := TEvaluatorVisitor.Create(boundScope);
Result := ANode.Accept(visitor);
end;
procedure TInterpreterScopeTests.Setup;
begin
FGlobalScope := TAst.CreateScope(nil);
end;
procedure TInterpreterScopeTests.TearDown;
begin
FGlobalScope := nil;
end;
procedure TInterpreterScopeTests.Test_DeeplyNestedLambda_ModifiesUpvalue;
var
mainBlock: IAstNode;
resultValue: TDataValue;
begin
// This is our original, simple test case with three nested lambdas.
mainBlock :=
TAst.Block(
[
TAst.VarDecl(
TAst.Identifier('outer'),
TAst.LambdaExpr(
[],
TAst.Block(
[
TAst.VarDecl(TAst.Identifier('x'), TAst.Constant(TScalar.FromInt64(10))),
TAst.VarDecl(
TAst.Identifier('inner'),
TAst.LambdaExpr(
[],
TAst.Block(
[
TAst.VarDecl(
TAst.Identifier('innermost'),
TAst.LambdaExpr(
[],
TAst.Assign(
TAst.Identifier('x'),
TAst.BinaryExpr(
TAst.Identifier('x'),
boAdd,
TAst.Constant(TScalar.FromInt64(5))
)
)
)
),
TAst.FunctionCall(TAst.Identifier('innermost'), [])
]
)
)
),
TAst.FunctionCall(TAst.Identifier('inner'), []),
TAst.Identifier('x')
]
)
)
),
TAst.VarDecl(TAst.Identifier('finalResult'), TAst.FunctionCall(TAst.Identifier('outer'), []))
]
);
resultValue := Execute(mainBlock);
Assert.AreEqual<Int64>(15, resultValue.AsScalar.Value.AsInt64, 'The final result should be 15.');
end;
procedure TInterpreterScopeTests.Test_SeparateClosures_ShareSameUpvalue;
var
mainBlock: IAstNode;
resultValue: TDataValue;
begin
// This is our more complex "modifier/reader" test case.
mainBlock :=
TAst.Block(
[
TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(TScalar.FromInt64(10))),
TAst.VarDecl(
TAst.Identifier('modifier'),
TAst.LambdaExpr(
[], // Outer modifier shell
TAst.LambdaExpr(
[], // Inner closure that is returned
TAst.Assign(
TAst.Identifier('a'),
TAst.BinaryExpr(TAst.Identifier('a'), boAdd, TAst.Constant(TScalar.FromInt64(5)))
)
)
)
),
TAst.VarDecl(TAst.Identifier('reader'), TAst.LambdaExpr([], TAst.Identifier('a'))),
TAst.VarDecl(TAst.Identifier('innermost_closure'), TAst.FunctionCall(TAst.Identifier('modifier'), [])),
TAst.FunctionCall(TAst.Identifier('innermost_closure'), []),
TAst.FunctionCall(TAst.Identifier('reader'), [])
]
);
resultValue := Execute(mainBlock);
Assert.AreEqual<Int64>(15, resultValue.AsScalar.Value.AsInt64, 'The final result should be 15.');
end;
procedure TInterpreterScopeTests.Test_NestedLambda_CapturesParameter;
var
mainBlock: IAstNode;
resultValue: TDataValue;
begin
// Tests if a nested lambda can correctly capture a PARAMETER of its parent lambda.
mainBlock :=
TAst.Block(
[
TAst.VarDecl(
TAst.Identifier('factory'),
TAst.LambdaExpr(
[TAst.Identifier('p')], // Parameter 'p'
TAst.LambdaExpr(
[], // Returned lambda captures 'p'
TAst.BinaryExpr(TAst.Identifier('p'), boMultiply, TAst.Constant(TScalar.FromInt64(2)))
)
)
),
TAst.VarDecl(
TAst.Identifier('multiplier'),
TAst.FunctionCall(TAst.Identifier('factory'), [TAst.Constant(TScalar.FromInt64(21))])
),
TAst.FunctionCall(TAst.Identifier('multiplier'), [])
]
);
resultValue := Execute(mainBlock);
Assert.AreEqual<Int64>(42, resultValue.AsScalar.Value.AsInt64, 'The result of 21 * 2 should be 42.');
end;
procedure TInterpreterScopeTests.Test_VariableShadowing_DoesNotAffectUpvalue;
var
mainBlock: IAstNode;
resultValue: TDataValue;
begin
// Tests that a local variable 'x' correctly "shadows" a parent's variable 'x'.
// The modification of the inner 'x' must not affect the outer 'x'.
mainBlock :=
TAst.Block(
[
TAst.VarDecl(TAst.Identifier('x'), TAst.Constant(TScalar.FromInt64(10))),
TAst.FunctionCall(
TAst.LambdaExpr(
[],
TAst.Block(
[
// This 'x' should shadow the outer 'x'.
TAst.VarDecl(TAst.Identifier('x'), TAst.Constant(TScalar.FromInt64(50))),
TAst.Assign(TAst.Identifier('x'), TAst.Constant(TScalar.FromInt64(99)))
]
)
),
[]
),
// This final expression should return the value of the original, outer 'x'.
TAst.Identifier('x')
]
);
resultValue := Execute(mainBlock);
Assert.AreEqual<Int64>(10, resultValue.AsScalar.Value.AsInt64, 'The outer "x" should remain unchanged.');
end;
procedure TInterpreterScopeTests.Test_CaptureFromGlobalScope;
var
mainBlock: IAstNode;
resultValue: TDataValue;
begin
// Defines a variable in the global scope and ensures a simple script can access it.
FGlobalScope.Define('g', TScalar.FromInt64(99));
mainBlock := TAst.BinaryExpr(TAst.Identifier('g'), boAdd, TAst.Constant(TScalar.FromInt64(1)));
resultValue := Execute(mainBlock);
Assert.AreEqual<Int64>(100, resultValue.AsScalar.Value.AsInt64, 'Should be able to access variables from the parent scope.');
end;
end.