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]
        [IgnoreMemoryLeaks]
        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.