Fixed unit tests

This commit is contained in:
Michael Schimmel
2025-09-29 12:18:44 +02:00
parent 2b34046efc
commit 18904f17d1
4 changed files with 97 additions and 38 deletions
+30 -32
View File
@@ -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<TDataValue>;
FIdx: Integer;
FScope: IExecutionScope;
FAddress: TResolvedAddress;
function GetValue: TDataValue;
procedure SetValue(const AValue: TDataValue);
public
constructor Create(const AValues: TArray<TDataValue>; AIdx: Integer);
constructor Create(const AScope: IExecutionScope; const AAddress: TResolvedAddress);
end;
private
@@ -131,7 +132,7 @@ type
property Symbols: TDictionary<string, Integer> 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<TDataValue>; 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);
-6
View File
@@ -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));
+16
View File
@@ -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;