Fix in Upvalue-Logic
This commit is contained in:
Michael Schimmel
+2
-1
@@ -40,7 +40,8 @@ uses
|
||||
Myc.Data.POD in '..\Src\Data\Myc.Data.Scalar.pas',
|
||||
Myc.Data.Decimal in '..\Src\Data\Myc.Data.Decimal.pas',
|
||||
TestDataDecimal in 'TestDataDecimal.pas',
|
||||
TestDataPOD in 'TestDataPOD.pas';
|
||||
TestDataPOD in 'TestDataPOD.pas',
|
||||
Test.Ast.Interpreter.Scope in 'Test.Ast.Interpreter.Scope.pas';
|
||||
|
||||
{ keep comment here to protect the following conditional from being removed by the IDE when adding a unit }
|
||||
{$IFNDEF TESTINSIGHT}
|
||||
|
||||
+1
-6
@@ -144,6 +144,7 @@ $(PreBuildEvent)]]></PreBuildEvent>
|
||||
<DCCReference Include="..\Src\Data\Myc.Data.Decimal.pas"/>
|
||||
<DCCReference Include="TestDataDecimal.pas"/>
|
||||
<DCCReference Include="TestDataPOD.pas"/>
|
||||
<DCCReference Include="Test.Ast.Interpreter.Scope.pas"/>
|
||||
<BuildConfiguration Include="Base">
|
||||
<Key>Base</Key>
|
||||
</BuildConfiguration>
|
||||
@@ -187,12 +188,6 @@ $(PreBuildEvent)]]></PreBuildEvent>
|
||||
<Overwrite>true</Overwrite>
|
||||
</Platform>
|
||||
</DeployFile>
|
||||
<DeployFile LocalName="..\Src\Data\Myc.Data.POD.pas" Configuration="Debug" Class="ProjectFile">
|
||||
<Platform Name="Win64">
|
||||
<RemoteDir>.\</RemoteDir>
|
||||
<Overwrite>true</Overwrite>
|
||||
</Platform>
|
||||
</DeployFile>
|
||||
<DeployFile LocalName="Win64\Debug\MycTests.exe" Configuration="Debug" Class="ProjectOutput">
|
||||
<Platform Name="Win64">
|
||||
<RemoteName>MycTests.exe</RemoteName>
|
||||
|
||||
@@ -0,0 +1,234 @@
|
||||
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.
|
||||
@@ -48,11 +48,6 @@ type
|
||||
procedure TestScalarTuple;
|
||||
[Test]
|
||||
procedure TestScalarRecordAndDefinition;
|
||||
[Test]
|
||||
procedure TestScalarSeries;
|
||||
|
||||
[Test]
|
||||
procedure TestScalarRecordSeries;
|
||||
end;
|
||||
|
||||
implementation
|
||||
@@ -254,73 +249,6 @@ begin
|
||||
);
|
||||
end;
|
||||
|
||||
procedure TTestPOD.TestScalarSeries;
|
||||
var
|
||||
seriesData: TArray<TScalarValue>;
|
||||
series: TSeries<TScalarValue>;
|
||||
scalarSeries: TScalarSeries;
|
||||
begin
|
||||
seriesData :=
|
||||
[
|
||||
TScalar.FromDouble(101.5).Value,
|
||||
TScalar.FromDouble(102.0).Value,
|
||||
TScalar.FromDouble(101.8).Value,
|
||||
TScalar.FromDouble(103.2).Value
|
||||
];
|
||||
|
||||
series := TSeries<TScalarValue>.CreateFromArray(seriesData, -1);
|
||||
scalarSeries := TScalarSeries.Create(skDouble, series);
|
||||
|
||||
Assert.AreEqual(skDouble, scalarSeries.Kind, 'Series kind mismatch');
|
||||
Assert.AreEqual(4, scalarSeries.Items.Count, 'Series count mismatch');
|
||||
Assert.AreEqual(Int64(4), scalarSeries.Items.TotalCount, 'Series total count mismatch');
|
||||
|
||||
// TSeries index is reversed: 0 is the last item
|
||||
Assert.AreEqual(103.2, scalarSeries.Items[0].AsDouble, 1E-12, 'Series item [0] mismatch');
|
||||
Assert.AreEqual(101.5, scalarSeries.Items[3].AsDouble, 1E-12, 'Series item [3] mismatch');
|
||||
end;
|
||||
|
||||
procedure TTestPOD.TestScalarRecordSeries;
|
||||
var
|
||||
recDef: TScalarRecordDefinition;
|
||||
series: TScalarRecordSeries;
|
||||
rec1, rec2, rec3: TScalarRecord;
|
||||
retrievedRec: TScalarRecord;
|
||||
begin
|
||||
// 1. Define the structure of the records in the series
|
||||
recDef := TScalarRecordDefinition.Create([TScalarRecordField.Create('ID', skInt64), TScalarRecordField.Create('Price', skDecimal)]);
|
||||
|
||||
// 2. Create the series with the definition
|
||||
series := TScalarRecordSeries.Create(recDef);
|
||||
Assert.AreEqual(Int64(0), series.TotalCount, 'Initial series should be empty');
|
||||
|
||||
// 3. Create some records
|
||||
rec1 := TScalarRecord.Create(recDef, [TScalarValue.FromInt64(1), TScalarValue.FromDecimal(TDecimal.Create(100, 2))]);
|
||||
rec2 := TScalarRecord.Create(recDef, [TScalarValue.FromInt64(2), TScalarValue.FromDecimal(TDecimal.Create(101, 2))]);
|
||||
rec3 := TScalarRecord.Create(recDef, [TScalarValue.FromInt64(3), TScalarValue.FromDecimal(TDecimal.Create(102, 2))]);
|
||||
|
||||
// 4. Add records to the series
|
||||
series.Add(rec1);
|
||||
series.Add(rec2);
|
||||
series.Add(rec3);
|
||||
|
||||
// 5. Verify the state of the series
|
||||
Assert.AreEqual(Int64(3), series.TotalCount, 'Series total count mismatch after adding items');
|
||||
|
||||
// 6. Check items. Index 0 is the last added item.
|
||||
retrievedRec := series.Items[0]; // Should be rec3
|
||||
Assert.AreEqual(skInt64, retrievedRec['ID'].Kind, 'Item[0] ID kind mismatch');
|
||||
Assert.AreEqual(Int64(3), retrievedRec['ID'].Value.AsInt64, 'Item[0] ID value mismatch');
|
||||
Assert.AreEqual(TDecimal.Create(102, 2), retrievedRec['Price'].Value.AsDecimal, 'Item[0] Price value mismatch');
|
||||
|
||||
retrievedRec := series.Items[1]; // Should be rec2
|
||||
Assert.AreEqual(Int64(2), retrievedRec.Items['ID'].Value.AsInt64, 'Item[1] ID value mismatch');
|
||||
|
||||
retrievedRec := series.Items[2]; // Should be rec1
|
||||
Assert.AreEqual(Int64(1), retrievedRec.Items['ID'].Value.AsInt64, 'Item[2] ID value mismatch');
|
||||
Assert.AreEqual(TDecimal.Create(100, 2), retrievedRec.Items['Price'].Value.AsDecimal, 'Item[2] Price value mismatch');
|
||||
end;
|
||||
|
||||
initialization
|
||||
FormatSettings.DecimalSeparator := '.';
|
||||
TDUnitX.RegisterTestFixture(TTestPOD);
|
||||
|
||||
Reference in New Issue
Block a user