diff --git a/Src/AST/Myc.Ast.Scope.pas b/Src/AST/Myc.Ast.Scope.pas index ea6d2d2..8f071b1 100644 --- a/Src/AST/Myc.Ast.Scope.pas +++ b/Src/AST/Myc.Ast.Scope.pas @@ -73,14 +73,15 @@ type constructor Create(const AValue: TDataValue); end; + // Corrected TValueRef: Holds a stable reference to the scope and address, not the raw array. TValueRef = class(TInterfacedObject, IValueCell) private - FValues: TArray; - FIdx: Integer; + FScope: IExecutionScope; + FAddress: TResolvedAddress; function GetValue: TDataValue; procedure SetValue(const AValue: TDataValue); public - constructor Create(const AValues: TArray; AIdx: Integer); + constructor Create(const AScope: IExecutionScope; const AAddress: TResolvedAddress); end; private @@ -131,7 +132,7 @@ type property Symbols: TDictionary read FSymbols; end; -{ TValueCell } +{ TExecutionScope.TValueCell } constructor TExecutionScope.TValueCell.Create(const AValue: TDataValue); begin @@ -149,6 +150,27 @@ begin FValue := AValue; end; +{ TExecutionScope.TValueRef } + +constructor TExecutionScope.TValueRef.Create(const AScope: IExecutionScope; const AAddress: TResolvedAddress); +begin + inherited Create; + FScope := AScope; + FAddress := AAddress; +end; + +function TExecutionScope.TValueRef.GetValue: TDataValue; +begin + // Delegate the call to the scope, which correctly handles parent traversal. + Result := FScope[FAddress]; +end; + +procedure TExecutionScope.TValueRef.SetValue(const AValue: TDataValue); +begin + // Delegate the call to the scope. + FScope[FAddress] := AValue; +end; + { TExecutionScope } constructor TExecutionScope.Create( @@ -215,17 +237,10 @@ begin end; akLocalOrParent: begin - var targetScope := Self; - for var i := 1 to Address.ScopeDepth do - begin - targetScope := targetScope.Parent as TExecutionScope; - Assert(Assigned(targetScope), 'Invalid scope depth during value retrieval.'); - end; - Assert( - (Address.SlotIndex >= 0) and (Address.SlotIndex < Length(targetScope.FValues)), - 'Invalid scope index during value retrieval.' - ); - Result := TValueRef.Create(targetScope.FValues, Address.SlotIndex); + // Corrected Implementation: Create a TValueRef that holds the current scope + // and the full address. The scope's indexer will handle the parent traversal correctly + // and is robust against array reallocations. + Result := TValueRef.Create(Self, Address); end; else raise EInvalidOpException.Create('Cannot get value for an unresolved address.'); @@ -393,23 +408,6 @@ begin end; end; -constructor TExecutionScope.TValueRef.Create(const AValues: TArray; AIdx: Integer); -begin - inherited Create; - FValues := AValues; - FIdx := AIdx; -end; - -function TExecutionScope.TValueRef.GetValue: TDataValue; -begin - Result := FValues[FIdx]; -end; - -procedure TExecutionScope.TValueRef.SetValue(const AValue: TDataValue); -begin - FValues[FIdx] := AValue; -end; - { TScopeDescriptor } constructor TScopeDescriptor.Create(const AParent: IScopeDescriptor); diff --git a/Src/AST/Myc.Ast.pas b/Src/AST/Myc.Ast.pas index d0933dd..78f6a7b 100644 --- a/Src/AST/Myc.Ast.pas +++ b/Src/AST/Myc.Ast.pas @@ -29,7 +29,6 @@ type // --- Factory functions --- class function Constant(const AValue: TDataValue): IConstantNode; overload; static; - class function Constant(const AValue: TScalar): IConstantNode; overload; static; class function Constant(const AValue: String): IConstantNode; overload; static; class function Identifier(AName: string): IIdentifierNode; static; class function BinaryExpr(ALeft: IAstNode; AOperator: TScalar.TBinaryOp; ARight: IAstNode): IBinaryExpressionNode; static; @@ -703,11 +702,6 @@ begin Result := TConstantNode.Create(AValue); end; -class function TAst.Constant(const AValue: TScalar): IConstantNode; -begin - Result := TConstantNode.Create(TDataValue(AValue)); -end; - class function TAst.Constant(const AValue: String): IConstantNode; begin Result := TConstantNode.Create(TDataValue(AValue)); diff --git a/Src/Data/Myc.Data.Value.pas b/Src/Data/Myc.Data.Value.pas index 6e7e14e..453930a 100644 --- a/Src/Data/Myc.Data.Value.pas +++ b/Src/Data/Myc.Data.Value.pas @@ -53,6 +53,8 @@ type class operator Initialize(out Dest: TDataValue); class function Void: TDataValue; inline; static; + class operator Implicit(const AValue: Int64): TDataValue; overload; inline; + class operator Implicit(const AValue: Double): TDataValue; overload; inline; class operator Implicit(const AValue: TScalar): TDataValue; overload; inline; class operator Implicit(const AValue: TDataValue): TScalar; overload; inline; class operator Implicit(const AValue: String): TDataValue; overload; inline; @@ -479,6 +481,20 @@ begin Result := AValue.AsScalar; end; +class operator TDataValue.Implicit(const AValue: Int64): TDataValue; +begin + Result.FKind := Ord(vkScalar); + Result.FScalar := TScalar.FromInt64(AValue); + Result.FInterface := nil; +end; + +class operator TDataValue.Implicit(const AValue: Double): TDataValue; +begin + Result.FKind := Ord(vkScalar); + Result.FScalar := TScalar.FromDouble(AValue); + Result.FInterface := nil; +end; + { TDataValueKindHelper } function TDataValueKindHelper.ToString: string; diff --git a/Test/Test.Ast.Interpreter.Scope.pas b/Test/Test.Ast.Interpreter.Scope.pas index fda6a22..f3d91c1 100644 --- a/Test/Test.Ast.Interpreter.Scope.pas +++ b/Test/Test.Ast.Interpreter.Scope.pas @@ -38,6 +38,10 @@ type [Test] procedure Test_CaptureFromGlobalScope; + + [Test] + procedure Test_ClosureCaptureWithParentScopeReallocation; + end; implementation @@ -236,4 +240,51 @@ begin Assert.AreEqual(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.