AST testing
This commit is contained in:
Michael Schimmel
@@ -0,0 +1,219 @@
|
||||
unit Test.Myc.Ast.RTL;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
DUnitX.TestFramework,
|
||||
System.SysUtils,
|
||||
System.Generics.Collections,
|
||||
System.Math,
|
||||
System.DateUtils,
|
||||
Myc.Data.Scalar,
|
||||
Myc.Data.Value,
|
||||
Myc.Ast.Types,
|
||||
Myc.Ast.Scope,
|
||||
Myc.Ast.RTL,
|
||||
Myc.Ast.RTL.Core;
|
||||
|
||||
type
|
||||
[TestFixture]
|
||||
TTestMycAstRTL = class
|
||||
private
|
||||
FScope: IExecutionScope;
|
||||
|
||||
function Call(const Name: string; const Args: array of TDataValue): TDataValue;
|
||||
function ValI(V: Int64): TDataValue;
|
||||
function ValF(V: Double): TDataValue;
|
||||
public
|
||||
[Setup]
|
||||
procedure Setup;
|
||||
|
||||
// --- Registration ---
|
||||
[Test]
|
||||
[IgnoreMemoryLeaks]
|
||||
procedure RTL_Registration_SymbolsArePresent;
|
||||
|
||||
// --- Floating Point Math ---
|
||||
[Test]
|
||||
[TestCase('Add_FF', '+,1.5,2.5,4.0')]
|
||||
[TestCase('Div_FF', '/,10,2,5.0')]
|
||||
procedure RTL_Math_Float(const Op: string; A, B, Expected: Double);
|
||||
|
||||
// --- Integer Math (New) ---
|
||||
[Test]
|
||||
[TestCase('Div_Int', 'div,10,3,3')]
|
||||
[TestCase('Mod_Int', 'mod,10,3,1')]
|
||||
procedure RTL_Math_Integer(const Op: string; A, B, Expected: Int64);
|
||||
|
||||
// --- Bitwise Operations (New) ---
|
||||
[Test]
|
||||
[TestCase('BitAnd', 'and,3,2,2')] // 011 & 010 = 010 (2)
|
||||
[TestCase('BitOr', 'or,1,2,3')] // 001 | 010 = 011 (3)
|
||||
[TestCase('BitXor', 'xor,3,1,2')] // 011 ^ 001 = 010 (2)
|
||||
[TestCase('Shl', 'shl,1,2,4')] // 1 << 2 = 4
|
||||
[TestCase('Shr', 'shr,4,1,2')] // 4 >> 1 = 2
|
||||
procedure RTL_Bitwise(const Op: string; A, B, Expected: Int64);
|
||||
|
||||
// --- Rounding (New) ---
|
||||
[Test]
|
||||
[TestCase('Round_Up', '3.6,4')]
|
||||
[TestCase('Round_Down', '3.4,3')]
|
||||
[TestCase('Round_Mid', '3.5,4')] // Banker's rounding or standard? Delphi default is Banker's.
|
||||
procedure RTL_Round_Works(A: Double; Expected: Int64);
|
||||
|
||||
// --- Comparisons ---
|
||||
[Test]
|
||||
[TestCase('Eq_True', '=,10,10,1')]
|
||||
[TestCase('Neq_True', '<>,10,20,1')]
|
||||
procedure RTL_Comparison_Ordinals(const Op: string; A, B: Int64; ExpectedBool: Int64);
|
||||
|
||||
// --- DateTime Logic (New) ---
|
||||
[Test]
|
||||
procedure RTL_DateTime_ConstructionAndMath;
|
||||
|
||||
// --- Error Handling ---
|
||||
[Test]
|
||||
procedure RTL_DivByZero_ThrowException;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Myc.Ast;
|
||||
|
||||
{ TTestMycAstRTL }
|
||||
|
||||
procedure TTestMycAstRTL.Setup;
|
||||
begin
|
||||
FScope := TAst.CreateScope(nil, nil, False);
|
||||
Myc.Ast.RTL.RegisterRtlFunctions(FScope);
|
||||
end;
|
||||
|
||||
// --- Helpers ---
|
||||
|
||||
function TTestMycAstRTL.ValI(V: Int64): TDataValue;
|
||||
begin
|
||||
Result := TDataValue(TScalar.FromInt64(V));
|
||||
end;
|
||||
|
||||
function TTestMycAstRTL.ValF(V: Double): TDataValue;
|
||||
begin
|
||||
Result := TDataValue(TScalar.FromDouble(V));
|
||||
end;
|
||||
|
||||
function TTestMycAstRTL.Call(const Name: string; const Args: array of TDataValue): TDataValue;
|
||||
var
|
||||
addr: TResolvedAddress;
|
||||
funcVal: TDataValue;
|
||||
func: TDataValue.TFunc;
|
||||
argArray: TArray<TDataValue>;
|
||||
i: Integer;
|
||||
begin
|
||||
addr := FScope.Resolve(Name);
|
||||
Assert.AreNotEqual(TAddressKind.akUnresolved, addr.Kind, 'Function not found: ' + Name);
|
||||
|
||||
funcVal := FScope[addr];
|
||||
func := funcVal.AsMethod();
|
||||
|
||||
SetLength(argArray, Length(Args));
|
||||
for i := 0 to High(Args) do
|
||||
argArray[i] := Args[i];
|
||||
|
||||
Result := func(argArray);
|
||||
end;
|
||||
|
||||
// --- Tests ---
|
||||
|
||||
procedure TTestMycAstRTL.RTL_Registration_SymbolsArePresent;
|
||||
begin
|
||||
Assert.AreNotEqual(TAddressKind.akUnresolved, FScope.Resolve('div').Kind);
|
||||
Assert.AreNotEqual(TAddressKind.akUnresolved, FScope.Resolve('mod').Kind);
|
||||
Assert.AreNotEqual(TAddressKind.akUnresolved, FScope.Resolve('Date').Kind);
|
||||
Assert.AreNotEqual(TAddressKind.akUnresolved, FScope.Resolve('Round').Kind);
|
||||
end;
|
||||
|
||||
procedure TTestMycAstRTL.RTL_Math_Float(const Op: string; A, B, Expected: Double);
|
||||
var
|
||||
res: TDataValue;
|
||||
begin
|
||||
res := Call(Op, [ValF(A), ValF(B)]);
|
||||
Assert.AreEqual(TDataValueKind.vkScalar, res.Kind);
|
||||
Assert.AreEqual(Expected, res.AsScalar.Value.AsDouble, 0.00001);
|
||||
end;
|
||||
|
||||
procedure TTestMycAstRTL.RTL_Math_Integer(const Op: string; A, B, Expected: Int64);
|
||||
var
|
||||
res: TDataValue;
|
||||
begin
|
||||
res := Call(Op, [ValI(A), ValI(B)]);
|
||||
Assert.AreEqual(TDataValueKind.vkScalar, res.Kind);
|
||||
Assert.AreEqual(TScalar.TKind.Ordinal, res.AsScalar.Kind);
|
||||
Assert.AreEqual(Expected, res.AsScalar.Value.AsInt64);
|
||||
end;
|
||||
|
||||
procedure TTestMycAstRTL.RTL_Bitwise(const Op: string; A, B, Expected: Int64);
|
||||
var
|
||||
res: TDataValue;
|
||||
begin
|
||||
res := Call(Op, [ValI(A), ValI(B)]);
|
||||
Assert.AreEqual(TScalar.TKind.Ordinal, res.AsScalar.Kind);
|
||||
Assert.AreEqual(Expected, res.AsScalar.Value.AsInt64);
|
||||
end;
|
||||
|
||||
procedure TTestMycAstRTL.RTL_Round_Works(A: Double; Expected: Int64);
|
||||
var
|
||||
res: TDataValue;
|
||||
begin
|
||||
res := Call('Round', [ValF(A)]);
|
||||
Assert.AreEqual(TScalar.TKind.Ordinal, res.AsScalar.Kind);
|
||||
Assert.AreEqual(Expected, res.AsScalar.Value.AsInt64);
|
||||
end;
|
||||
|
||||
procedure TTestMycAstRTL.RTL_Comparison_Ordinals(const Op: string; A, B: Int64; ExpectedBool: Int64);
|
||||
var
|
||||
res: TDataValue;
|
||||
begin
|
||||
res := Call(Op, [ValI(A), ValI(B)]);
|
||||
// Note: TScalar.Equal/NotEqual returns Boolean Kind now!
|
||||
// The test case expects integer 0 or 1, so we convert or check bool.
|
||||
// TScalar.Implicit(Boolean) -> Int64 (0/1) works.
|
||||
|
||||
Assert.AreEqual(TDataValueKind.vkScalar, res.Kind);
|
||||
Assert.AreEqual(TScalar.TKind.Boolean, res.AsScalar.Kind);
|
||||
|
||||
var asInt: Int64 := res.AsScalar; // Implicit conversion
|
||||
Assert.AreEqual(ExpectedBool, asInt);
|
||||
end;
|
||||
|
||||
procedure TTestMycAstRTL.RTL_DateTime_ConstructionAndMath;
|
||||
var
|
||||
d, d2, diff: TDataValue;
|
||||
expectedDate: TDateTime;
|
||||
begin
|
||||
// 1. Test Date(Y, M, D)
|
||||
expectedDate := EncodeDate(2023, 10, 5);
|
||||
d := Call('Date', [ValI(2023), ValI(10), ValI(5)]);
|
||||
|
||||
Assert.AreEqual(TScalar.TKind.DateTime, d.AsScalar.Kind);
|
||||
Assert.AreEqual(expectedDate, d.AsScalar.Value.AsDouble, 0.001);
|
||||
|
||||
// 2. Test Date + Int (Days)
|
||||
d2 := Call('+', [d, ValI(2)]); // Add 2 days
|
||||
Assert.AreEqual(TScalar.TKind.DateTime, d2.AsScalar.Kind);
|
||||
Assert.AreEqual(expectedDate + 2, d2.AsScalar.Value.AsDouble, 0.001);
|
||||
|
||||
// 3. Test Date - Date (Diff in days)
|
||||
diff := Call('-', [d2, d]);
|
||||
Assert.AreEqual(TScalar.TKind.Float, diff.AsScalar.Kind);
|
||||
Assert.AreEqual(2.0, diff.AsScalar.Value.AsDouble, 0.001);
|
||||
end;
|
||||
|
||||
procedure TTestMycAstRTL.RTL_DivByZero_ThrowException;
|
||||
begin
|
||||
// Integer div
|
||||
Assert.WillRaise(procedure begin Call('div', [ValI(10), ValI(0)]); end);
|
||||
// Float divide (explicit check in RTL)
|
||||
Assert.WillRaise(procedure begin Call('/', [ValF(10.0), ValF(0.0)]); end);
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,341 @@
|
||||
unit Test.Myc.Ast.Scope;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
DUnitX.TestFramework,
|
||||
System.SysUtils,
|
||||
System.Generics.Collections,
|
||||
Myc.Data.Value,
|
||||
Myc.Data.Scalar,
|
||||
Myc.Ast.Types,
|
||||
Myc.Ast.Scope;
|
||||
|
||||
type
|
||||
[TestFixture]
|
||||
TTestMycAstScope = class
|
||||
private
|
||||
// Helper to create a fully initialized scope with a specific set of variable names
|
||||
function CreateTestScope(const VarNames: array of string; Parent: IExecutionScope = nil): IExecutionScope;
|
||||
public
|
||||
// --- Group 1: Static Layout & Builder (Parameterized) ---
|
||||
|
||||
[Test]
|
||||
[TestCase('Simple_A', 'A,0')]
|
||||
[TestCase('Simple_B', 'B,1')]
|
||||
[TestCase('Simple_C', 'C,2')]
|
||||
procedure Builder_Define_AssignsSequentialSlots(const VarName: string; ExpectedSlot: Integer);
|
||||
|
||||
[Test]
|
||||
[TestCase('Find_A', 'A,0')]
|
||||
[TestCase('Find_B', 'B,1')]
|
||||
[TestCase('Find_Missing', 'Z,-1')]
|
||||
[TestCase('Case_Sensitivity_Check', 'a,-1')] // Verifying default behavior (Case Sensitive in current impl)
|
||||
procedure Builder_FindSlot_Checks(const SearchName: string; ExpectedSlot: Integer);
|
||||
|
||||
// --- Group 2: Runtime Execution Scope & Growth ---
|
||||
|
||||
[Test]
|
||||
procedure Scope_DynamicGrowth_ResizesValuesArray;
|
||||
|
||||
[Test]
|
||||
procedure Scope_Define_DuplicateName_ThrowsException;
|
||||
|
||||
// --- Group 3: Hierarchy & Shadowing (Parameterized Depth) ---
|
||||
|
||||
[Test]
|
||||
[TestCase('Depth_0', '0')]
|
||||
[TestCase('Depth_1', '1')]
|
||||
[TestCase('Depth_5', '5')]
|
||||
procedure Scope_Resolve_WorksAtVariousDepths(Depth: Integer);
|
||||
|
||||
[Test]
|
||||
procedure Scope_DeepNesting_StressTest; // Corner Case: 100+ Levels
|
||||
|
||||
// --- Group 4: Capture & Boxing (Closures) ---
|
||||
|
||||
[Test]
|
||||
procedure Scope_Capture_Identity_RepeatedCaptureReturnsSameCell;
|
||||
|
||||
[Test]
|
||||
procedure Scope_Capture_Of_Already_Captured_Upvalue;
|
||||
|
||||
[Test]
|
||||
procedure Scope_Uninitialized_Access_ReturnsVoidOrZero;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TTestMycAstScope }
|
||||
|
||||
function TTestMycAstScope.CreateTestScope(const VarNames: array of string; Parent: IExecutionScope): IExecutionScope;
|
||||
var
|
||||
parentLayout: IScopeLayout;
|
||||
builder: IScopeBuilder;
|
||||
layout: IScopeLayout;
|
||||
descriptor: IScopeDescriptor;
|
||||
types: TArray<IStaticType>;
|
||||
i: Integer;
|
||||
begin
|
||||
if Assigned(Parent) then
|
||||
parentLayout := Parent.Descriptor.Layout
|
||||
else
|
||||
parentLayout := nil;
|
||||
|
||||
builder := TScope.CreateBuilder(parentLayout);
|
||||
for i := 0 to High(VarNames) do
|
||||
builder.Define(VarNames[i]);
|
||||
layout := builder.Build;
|
||||
|
||||
SetLength(types, Length(VarNames));
|
||||
for i := 0 to High(types) do
|
||||
types[i] := TTypes.Unknown;
|
||||
|
||||
descriptor := TScope.CreateDescriptor(layout, types);
|
||||
Result := TScope.CreateScope(Parent, descriptor, nil);
|
||||
end;
|
||||
|
||||
// ------------------------------------------------------------------------
|
||||
// Group 1: Static Layout & Builder
|
||||
// ------------------------------------------------------------------------
|
||||
|
||||
procedure TTestMycAstScope.Builder_Define_AssignsSequentialSlots(const VarName: string; ExpectedSlot: Integer);
|
||||
var
|
||||
builder: IScopeBuilder;
|
||||
begin
|
||||
builder := TScope.CreateBuilder(nil);
|
||||
// We define the context first
|
||||
builder.Define('A'); // 0
|
||||
builder.Define('B'); // 1
|
||||
builder.Define('C'); // 2
|
||||
|
||||
// Note: Since we construct the builder fresh every time, we simulate looking up
|
||||
// in a builder that has these 3 defined.
|
||||
// However, `Define` returns the index.
|
||||
// To test Define return value correctly based on TestCase, we'd need a switch.
|
||||
// Instead, let's test FindSlot here which validates the Define logic implicitly.
|
||||
|
||||
Assert.AreEqual(ExpectedSlot, builder.FindSlot(VarName));
|
||||
end;
|
||||
|
||||
procedure TTestMycAstScope.Builder_FindSlot_Checks(const SearchName: string; ExpectedSlot: Integer);
|
||||
var
|
||||
builder: IScopeBuilder;
|
||||
begin
|
||||
builder := TScope.CreateBuilder(nil);
|
||||
builder.Define('A');
|
||||
builder.Define('B');
|
||||
|
||||
Assert.AreEqual(ExpectedSlot, builder.FindSlot(SearchName));
|
||||
end;
|
||||
|
||||
// ------------------------------------------------------------------------
|
||||
// Group 2: Runtime Execution Scope & Growth
|
||||
// ------------------------------------------------------------------------
|
||||
|
||||
procedure TTestMycAstScope.Scope_DynamicGrowth_ResizesValuesArray;
|
||||
var
|
||||
scope: IExecutionScope;
|
||||
addr: TResolvedAddress;
|
||||
val: TDataValue;
|
||||
begin
|
||||
// Corner Case: Defining variables in a scope WITHOUT a descriptor (Dynamic Interpreter Mode)
|
||||
// The internal array must grow.
|
||||
scope := TScope.CreateScope(nil, nil, nil);
|
||||
|
||||
// Slot 0
|
||||
scope.Define('A', 10);
|
||||
|
||||
// Slot 100 (Simulation of a large jump or massive definition sequence)
|
||||
// Note: TExecutionScope.Define assigns sequential slots. To test resize, we loop.
|
||||
for var i := 1 to 100 do
|
||||
scope.Define('V' + i.ToString, i);
|
||||
|
||||
addr := scope.Resolve('V100');
|
||||
Assert.AreEqual(100, addr.SlotIndex);
|
||||
|
||||
val := scope[addr];
|
||||
Assert.AreEqual(Int64(100), val.AsScalar.Value.AsInt64);
|
||||
end;
|
||||
|
||||
procedure TTestMycAstScope.Scope_Define_DuplicateName_ThrowsException;
|
||||
var
|
||||
scope: IExecutionScope;
|
||||
begin
|
||||
scope := TScope.CreateScope(nil, nil, nil);
|
||||
scope.Define('X', 1);
|
||||
|
||||
Assert.WillRaise(procedure begin scope.Define('X', 2); end);
|
||||
end;
|
||||
|
||||
procedure TTestMycAstScope.Scope_Uninitialized_Access_ReturnsVoidOrZero;
|
||||
var
|
||||
builder: IScopeBuilder;
|
||||
layout: IScopeLayout;
|
||||
descriptor: IScopeDescriptor;
|
||||
scope: IExecutionScope;
|
||||
addr: TResolvedAddress;
|
||||
begin
|
||||
// Static Layout defined, but value not set in Scope
|
||||
builder := TScope.CreateBuilder(nil);
|
||||
builder.Define('A'); // Slot 0
|
||||
layout := builder.Build;
|
||||
descriptor := TScope.CreateDescriptor(layout, [TTypes.Unknown]);
|
||||
|
||||
scope := TScope.CreateScope(nil, descriptor, nil);
|
||||
|
||||
addr.Kind := akLocalOrParent;
|
||||
addr.ScopeDepth := 0;
|
||||
addr.SlotIndex := 0;
|
||||
|
||||
// Accessing before writing
|
||||
// TDataValue defaults to Kind=vkVoid via Initialize operator usually,
|
||||
// but let's verify TExecutionScope constructor zeros memory or initializes generic array.
|
||||
Assert.IsTrue(scope[addr].IsVoid, 'Uninitialized slot should be Void');
|
||||
end;
|
||||
|
||||
// ------------------------------------------------------------------------
|
||||
// Group 3: Hierarchy & Shadowing
|
||||
// ------------------------------------------------------------------------
|
||||
|
||||
procedure TTestMycAstScope.Scope_Resolve_WorksAtVariousDepths(Depth: Integer);
|
||||
var
|
||||
scopes: TArray<IExecutionScope>;
|
||||
i: Integer;
|
||||
addr: TResolvedAddress;
|
||||
begin
|
||||
SetLength(scopes, Depth + 1);
|
||||
|
||||
// Root defines Target
|
||||
scopes[0] := CreateTestScope(['Target']);
|
||||
|
||||
// Chain creation
|
||||
for i := 1 to Depth do
|
||||
scopes[i] := CreateTestScope([], scopes[i - 1]);
|
||||
|
||||
// Resolve from the deepest scope
|
||||
addr := scopes[Depth].Resolve('Target');
|
||||
|
||||
Assert.AreEqual(TAddressKind.akLocalOrParent, addr.Kind);
|
||||
Assert.AreEqual(Depth, addr.ScopeDepth);
|
||||
Assert.AreEqual(0, addr.SlotIndex);
|
||||
end;
|
||||
|
||||
procedure TTestMycAstScope.Scope_DeepNesting_StressTest;
|
||||
const
|
||||
MAX_DEPTH = 100;
|
||||
var
|
||||
scopes: array[0..MAX_DEPTH] of IExecutionScope;
|
||||
i: Integer;
|
||||
addr: TResolvedAddress;
|
||||
val: TDataValue;
|
||||
begin
|
||||
// Corner Case: Deep Recursion / Stack Limits on Resolution
|
||||
|
||||
// 1. Create Root Scope with 'DeepVar' defined in the Layout
|
||||
scopes[0] := CreateTestScope(['DeepVar']);
|
||||
|
||||
// 2. Set the value for the EXISTING variable.
|
||||
// Do NOT call Define() again, as it would try to create a duplicate slot.
|
||||
addr := scopes[0].Resolve('DeepVar');
|
||||
Assert.AreEqual(TAddressKind.akLocalOrParent, addr.Kind, 'DeepVar must be resolvable in root');
|
||||
scopes[0][addr] := 999;
|
||||
|
||||
// 3. Build deep nesting chain
|
||||
for i := 1 to MAX_DEPTH do
|
||||
scopes[i] := CreateTestScope([], scopes[i - 1]);
|
||||
|
||||
// 4. Resolve from the deepest leaf
|
||||
// This forces the Resolve() method to traverse 100 parent pointers.
|
||||
addr := scopes[MAX_DEPTH].Resolve('DeepVar');
|
||||
|
||||
Assert.AreEqual(TAddressKind.akLocalOrParent, addr.Kind);
|
||||
Assert.AreEqual(MAX_DEPTH, addr.ScopeDepth, 'ScopeDepth must match nesting level');
|
||||
|
||||
// 5. Read the value through the deep link
|
||||
val := scopes[MAX_DEPTH][addr];
|
||||
Assert.AreEqual(Int64(999), val.AsScalar.Value.AsInt64);
|
||||
end;
|
||||
|
||||
// ------------------------------------------------------------------------
|
||||
// Group 4: Capture & Boxing (Closures) - CRITICAL
|
||||
// ------------------------------------------------------------------------
|
||||
|
||||
procedure TTestMycAstScope.Scope_Capture_Identity_RepeatedCaptureReturnsSameCell;
|
||||
var
|
||||
scope: IExecutionScope;
|
||||
addr: TResolvedAddress;
|
||||
cell1, cell2: IValueCell;
|
||||
begin
|
||||
// Corner Case: If I capture the same variable twice (e.g. two lambdas in same scope using same var),
|
||||
// they MUST share the underlying storage (Box).
|
||||
|
||||
scope := CreateTestScope(['A']);
|
||||
addr := scope.Resolve('A');
|
||||
|
||||
cell1 := scope.Capture(addr);
|
||||
cell2 := scope.Capture(addr);
|
||||
|
||||
// They must be the same interface pointer instance
|
||||
Assert.IsTrue(cell1 = cell2, 'Repeated capture must return identical interface instance');
|
||||
|
||||
// Modify one, check other
|
||||
cell1.Value := 100;
|
||||
Assert.AreEqual(Int64(100), cell2.Value.AsScalar.Value.AsInt64);
|
||||
end;
|
||||
|
||||
procedure TTestMycAstScope.Scope_Capture_Of_Already_Captured_Upvalue;
|
||||
var
|
||||
root, mid, leaf: IExecutionScope;
|
||||
rootAddr: TResolvedAddress;
|
||||
midAddr: TResolvedAddress; // Points to root's var as an upvalue
|
||||
leafAddr: TResolvedAddress;
|
||||
cellRoot: IValueCell;
|
||||
capturedInMid: TArray<IValueCell>;
|
||||
begin
|
||||
// Scenario:
|
||||
// Root: [VarX]
|
||||
// Mid: (Captures VarX from Root) -> This creates a closure context for Mid
|
||||
// Leaf: (Captures VarX from Mid) -> This captures the *already captured* cell
|
||||
|
||||
// 1. Root
|
||||
root := CreateTestScope(['VarX']);
|
||||
rootAddr := root.Resolve('VarX');
|
||||
root[rootAddr] := 42;
|
||||
|
||||
// 2. Mid (Simulate a Lambda Scope that captured VarX)
|
||||
// To simulate this, we need to construct Mid such that it has 'capturedUpvalues' populated.
|
||||
// We manually capture from root first.
|
||||
cellRoot := root.Capture(rootAddr);
|
||||
SetLength(capturedInMid, 1);
|
||||
capturedInMid[0] := cellRoot;
|
||||
|
||||
// Mid's descriptor needs to know it has an upvalue?
|
||||
// No, IExecutionScope just holds the array. The address resolution handles mapping.
|
||||
mid := TScope.CreateScope(root, nil, capturedInMid);
|
||||
|
||||
// 3. Leaf resolves VarX.
|
||||
// If Leaf is physically inside Mid, it might refer to VarX via Mid's Upvalue list.
|
||||
// Address: Kind=akUpvalue, Slot=0 (index into capturedInMid)
|
||||
leafAddr.Kind := akUpvalue;
|
||||
leafAddr.SlotIndex := 0;
|
||||
// Note: ScopeDepth irrelevant for akUpvalue access
|
||||
|
||||
// 4. Test Access from Leaf via Upvalue chain
|
||||
// leaf does not have its own captured array yet, but we ask it to GET the value at that address
|
||||
// Actually, 'leaf' typically represents the *execution* of the lambda.
|
||||
// If the lambda code says "get upvalue 0", the evaluator calls GetValues(akUpvalue, 0).
|
||||
|
||||
// Let's simulate Leaf access:
|
||||
leaf := TScope.CreateScope(mid, nil, capturedInMid); // Leaf shares the capture array for this test context
|
||||
|
||||
Assert.AreEqual(Int64(42), leaf[leafAddr].AsScalar.Value.AsInt64);
|
||||
|
||||
// 5. Modify via Leaf reference
|
||||
leaf[leafAddr] := 99;
|
||||
|
||||
// Check Root
|
||||
Assert.AreEqual(Int64(99), root[rootAddr].AsScalar.Value.AsInt64);
|
||||
end;
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user