Michael Schimmel
342 lines
12 KiB
ObjectPascal
342 lines
12 KiB
ObjectPascal
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.
|