Michael Schimmel
296 lines
11 KiB
ObjectPascal
296 lines
11 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;
|
|
|
|
[Test]
|
|
procedure Test_ClosureCaptureWithParentScopeReallocation;
|
|
|
|
end;
|
|
|
|
implementation
|
|
|
|
{ TInterpreterScopeTests }
|
|
|
|
function TInterpreterScopeTests.Execute(const ANode: IAstNode): TDataValue;
|
|
var
|
|
boundNode: IAstNode;
|
|
descriptor: IScopeDescriptor;
|
|
runtimeScope: IExecutionScope;
|
|
visitor: IEvaluatorVisitor;
|
|
begin
|
|
// Helper to encapsulate the Bind -> CreateScope -> Evaluate pattern.
|
|
// The binder needs an evaluator factory to expand macros (even if there are none).
|
|
boundNode :=
|
|
TAstBinder.Bind(
|
|
FGlobalScope,
|
|
ANode,
|
|
descriptor,
|
|
function(const Scope: IExecutionScope): IEvaluatorVisitor begin Result := TEvaluatorVisitor.Create(Scope); end
|
|
);
|
|
runtimeScope := descriptor.CreateScope(FGlobalScope);
|
|
visitor := TEvaluatorVisitor.Create(runtimeScope);
|
|
Result := visitor.Execute(boundNode);
|
|
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'),
|
|
TScalar.TBinaryOp.Add,
|
|
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'), TScalar.TBinaryOp.Add, 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'), TScalar.TBinaryOp.Multiply, 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'), TScalar.TBinaryOp.Add, 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;
|
|
|
|
procedure TInterpreterScopeTests.Test_ClosureCaptureWithParentScopeReallocation;
|
|
var
|
|
rootScope: IExecutionScope;
|
|
parentScope: IExecutionScope;
|
|
lambdaScope: IExecutionScope;
|
|
addressOfX_from_lambda: TResolvedAddress;
|
|
addressOfX_in_parent: TResolvedAddress;
|
|
capturedCell: IValueCell;
|
|
valueFromClosure: TDataValue;
|
|
begin
|
|
// 1. Setup scopes: root -> parent -> lambda
|
|
rootScope := TScope.CreateScope(nil, nil, nil);
|
|
parentScope := TScope.CreateScope(rootScope, nil, nil);
|
|
lambdaScope := TScope.CreateScope(parentScope, nil, nil);
|
|
|
|
// 2. Define a variable 'x' in the parent scope. It will be at slot 0.
|
|
parentScope.Define('x', 10);
|
|
addressOfX_in_parent := TResolvedAddress.Create(akLocalOrParent, 0, 0);
|
|
Assert.AreEqual(Int64(10), parentScope[addressOfX_in_parent].AsScalar.Value.AsInt64);
|
|
|
|
// 3. From the lambda's perspective, 'x' is one level up (ScopeDepth=1) at slot 0.
|
|
addressOfX_from_lambda := TResolvedAddress.Create(akLocalOrParent, 1, 0);
|
|
|
|
// 4. Capture 'x' into a value cell, simulating a closure.
|
|
// This creates the buggy TValueRef that holds a direct reference to the parent's internal array.
|
|
capturedCell := lambdaScope.Capture(addressOfX_from_lambda);
|
|
Assert.AreEqual(Int64(10), capturedCell.Value.AsScalar.Value.AsInt64, 'Initial captured value should be correct');
|
|
|
|
// 5. Trigger the bug: Define another variable in the parent scope.
|
|
// This forces a SetLength on the internal FValues array, which may cause a reallocation.
|
|
parentScope.Define('y', 20);
|
|
|
|
// 6. Update the original variable 'x' in the parent scope to a new value.
|
|
parentScope[addressOfX_in_parent] := 99;
|
|
Assert.AreEqual(Int64(99), parentScope[addressOfX_in_parent].AsScalar.Value.AsInt64, 'Value in parent scope should be updated');
|
|
|
|
// 7. Read the value from the captured cell again.
|
|
// The test will fail here. The captured cell still points to the old, orphaned memory block
|
|
// where the value of x is still 10, not the new value 99.
|
|
valueFromClosure := capturedCell.Value;
|
|
Assert.AreEqual(
|
|
Int64(99),
|
|
valueFromClosure.AsScalar.Value.AsInt64,
|
|
'The captured cell must reflect changes in the parent scope after reallocation'
|
|
);
|
|
end;
|
|
|
|
end.
|