paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-13 10:09:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

FpDebug: fix crash with cached flatten data. Values must not refer to expression (as expression is not part of the cache)

Browse Source
This commit is contained in:
Martin 2024-10-09 00:28:36 +02:00
parent 713fb485d4
commit ca83c7dbca
1 changed files with 61 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

87
components/fpdebug/fppascalparser.pas
View File

@ -826,11 +826,15 @@ type
TFpPasParserValue = class(TFpValue) TFpPasParserValue = class(TFpValue)
private private
FContext: TFpDbgSimpleLocationContext; FContext: TFpDbgSimpleLocationContext;
FExpressionPart: TFpPascalExpressionPart; // Pos and Text from expressionpart / used in errors
FExprPos: Integer;
FExprText: String;
protected protected
function DebugText(AIndent: String): String; virtual; function DebugText(AIndent: String): String; virtual;
function CreateErrorWithPos(AnErrorCode: TFpErrorCode; AData: array of const): TFpError;
public public
constructor Create(AnExpressionPart: TFpPascalExpressionPart); constructor Create(AnExpressionPart: TFpPascalExpressionPart);
constructor Create(AContext: TFpDbgSimpleLocationContext; AnExprPos: Integer; AnExprText: String);
property Context: TFpDbgSimpleLocationContext read FContext; property Context: TFpDbgSimpleLocationContext read FContext;
end; end;
@ -841,6 +845,7 @@ type
FLowBoundIndex: TFpPasParserValueSlicedArrayIndex; FLowBoundIndex: TFpPasParserValueSlicedArrayIndex;
FArraySlice: TFpPascalExpressionPartOperatorArraySliceController; FArraySlice: TFpPascalExpressionPartOperatorArraySliceController;
FOwnsController: Boolean; FOwnsController: Boolean;
FExpressionPartInValue: TFpPascalExpressionPart;
protected protected
//function DebugText(AIndent: String): String; override; //function DebugText(AIndent: String): String; override;
function SlicePart: TFpPascalExpressionPartOperatorArraySlice; inline; function SlicePart: TFpPascalExpressionPartOperatorArraySlice; inline;
@ -913,15 +918,18 @@ type
TPasParserSymbolPointer = class(TFpSymbol) TPasParserSymbolPointer = class(TFpSymbol)
private private
FExpressionPart: TFpPascalExpressionPart;
FPointerLevels: Integer; FPointerLevels: Integer;
FPointedTo: TFpSymbol; FPointedTo: TFpSymbol;
FContext: TFpDbgLocationContext; FContext: TFpDbgSimpleLocationContext;
// Pos and Text from expressionpart / used in errors
FExprPos: Integer;
FExprText: String;
protected protected
// NameNeeded // "^TPointedTo" // NameNeeded // "^TPointedTo"
procedure TypeInfoNeeded; override; procedure TypeInfoNeeded; override;
function DoReadSize(const AValueObj: TFpValue; out ASize: TFpDbgValueSize): Boolean; override; function DoReadSize(const AValueObj: TFpValue; out ASize: TFpDbgValueSize): Boolean; override;
public public
constructor Create(const APointedTo: TFpSymbol; AContext: TFpDbgSimpleLocationContext; AnExprPos: Integer; AnExprText: String; APointerLevels: Integer);
constructor Create(const APointedTo: TFpSymbol; AnExpressionPart: TFpPascalExpressionPart; APointerLevels: Integer); constructor Create(const APointedTo: TFpSymbol; AnExpressionPart: TFpPascalExpressionPart; APointerLevels: Integer);
constructor Create(const APointedTo: TFpSymbol; AnExpressionPart: TFpPascalExpressionPart); constructor Create(const APointedTo: TFpSymbol; AnExpressionPart: TFpPascalExpressionPart);
destructor Destroy; override; destructor Destroy; override;
@ -932,14 +940,13 @@ type
TPasParserSymbolArrayDeIndex = class(TFpSymbolForwarder) // 1 index level off TPasParserSymbolArrayDeIndex = class(TFpSymbolForwarder) // 1 index level off
private private
FExpressionPart: TFpPascalExpressionPart;
FArray: TFpSymbol; FArray: TFpSymbol;
protected protected
//procedure ForwardToSymbolNeeded; override; //procedure ForwardToSymbolNeeded; override;
function GetNestedSymbolCount: Integer; override; function GetNestedSymbolCount: Integer; override;
function GetNestedSymbol(AIndex: Int64): TFpSymbol; override; function GetNestedSymbol(AIndex: Int64): TFpSymbol; override;
public public
constructor Create(AnExpressionPart: TFpPascalExpressionPart; const AnArray: TFpSymbol); constructor Create(const AnArray: TFpSymbol);
destructor Destroy; override; destructor Destroy; override;
end; end;
@ -968,7 +975,7 @@ type
function GetDerefAddress: TFpDbgMemLocation; override; function GetDerefAddress: TFpDbgMemLocation; override;
function GetMember(AIndex: Int64): TFpValue; override; function GetMember(AIndex: Int64): TFpValue; override;
public public
constructor Create(AValue: TFpValue; ATypeInfo: TFpSymbol; AnExpressionPart: TFpPascalExpressionPart); constructor Create(AValue: TFpValue; ATypeInfo: TFpSymbol; AContext: TFpDbgSimpleLocationContext; AnExprPos: Integer; AnExprText: String);
destructor Destroy; override; destructor Destroy; override;
end; end;
@ -1141,7 +1148,7 @@ end;
function ValueToExprText(AnValue: TFpValue; AMaxLen: Integer = 0): String; function ValueToExprText(AnValue: TFpValue; AMaxLen: Integer = 0): String;
begin begin
if AnValue is TFpPasParserValue then if AnValue is TFpPasParserValue then
Result := TFpPasParserValue(AnValue).FExpressionPart.GetFullText(AMaxLen) Result := TFpPasParserValue(AnValue).FExprText
else else
if AnValue.DbgSymbol <> nil then if AnValue.DbgSymbol <> nil then
Result := AnValue.DbgSymbol.Name Result := AnValue.DbgSymbol.Name
@ -1206,10 +1213,28 @@ begin
Result := AIndent + DbgSName(Self) + ' DbsSym='+DbgSName(DbgSymbol)+' Type='+DbgSName(TypeInfo) + LineEnding; Result := AIndent + DbgSName(Self) + ' DbsSym='+DbgSName(DbgSymbol)+' Type='+DbgSName(TypeInfo) + LineEnding;
end; end;
function TFpPasParserValue.CreateErrorWithPos(AnErrorCode: TFpErrorCode;
AData: array of const): TFpError;
begin
if FExprPos = 1
then Result := CreateError(AnErrorCode, AData, CreateError(fpErrPasParser_AtStart, [] ))
else Result := CreateError(AnErrorCode, AData, CreateError(fpErrPasParser_Position, [FExprPos]));
end;
constructor TFpPasParserValue.Create(AnExpressionPart: TFpPascalExpressionPart); constructor TFpPasParserValue.Create(AnExpressionPart: TFpPascalExpressionPart);
begin begin
FExpressionPart := AnExpressionPart; Create(AnExpressionPart.ExpressionData.Scope.LocationContext,
FContext := AnExpressionPart.ExpressionData.Scope.LocationContext; AnExpressionPart.GetPos,
AnExpressionPart.GetText(MAX_ERR_EXPR_QUOTE_LEN));
inherited Create;
end;
constructor TFpPasParserValue.Create(AContext: TFpDbgSimpleLocationContext; AnExprPos: Integer;
AnExprText: String);
begin
FContext := AContext;
FExprPos := AnExprPos;
FExprText := AnExprText;
inherited Create; inherited Create;
end; end;
@ -1276,7 +1301,7 @@ begin
end end
else begin else begin
if FValue is TFpPasParserValue then if FValue is TFpPasParserValue then
SetLastError(FExpressionPart.CreateErrorWithPos(fpErrCannotCastToPointer_p, SetLastError(CreateErrorWithPos(fpErrCannotCastToPointer_p,
[ValueToExprText(FValue, MAX_ERR_EXPR_QUOTE_LEN)] [ValueToExprText(FValue, MAX_ERR_EXPR_QUOTE_LEN)]
)); ));
end; end;
@ -1380,7 +1405,7 @@ begin
ti := FTypeSymbol.TypeInfo; ti := FTypeSymbol.TypeInfo;
addr := DerefAddress; addr := DerefAddress;
if not IsTargetAddr(addr) then begin if not IsTargetAddr(addr) then begin
SetLastError(FExpressionPart.CreateErrorWithPos(fpErrCannotDeref_p, SetLastError(CreateErrorWithPos(fpErrCannotDeref_p,
[ValueToExprText(FValue, MAX_ERR_EXPR_QUOTE_LEN)] [ValueToExprText(FValue, MAX_ERR_EXPR_QUOTE_LEN)]
)); ));
exit; exit;
@ -1409,10 +1434,10 @@ begin
Result := Tmp; Result := Tmp;
end; end;
constructor TFpPasParserValueCastToPointer.Create(AValue: TFpValue; constructor TFpPasParserValueCastToPointer.Create(AValue: TFpValue; ATypeInfo: TFpSymbol;
ATypeInfo: TFpSymbol; AnExpressionPart: TFpPascalExpressionPart); AContext: TFpDbgSimpleLocationContext; AnExprPos: Integer; AnExprText: String);
begin begin
inherited Create(AnExpressionPart); inherited Create(AContext, AnExprPos, AnExprText);
FValue := AValue; FValue := AValue;
FValue.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FValue, 'TPasParserSymbolValueCastToPointer'){$ENDIF}; FValue.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FValue, 'TPasParserSymbolValueCastToPointer'){$ENDIF};
FTypeSymbol := ATypeInfo; FTypeSymbol := ATypeInfo;
@ -1440,7 +1465,7 @@ end;
function TFpPasParserValueMakeReftype.GetDbgSymbol: TFpSymbol; function TFpPasParserValueMakeReftype.GetDbgSymbol: TFpSymbol;
begin begin
if FTypeSymbol = nil then begin if FTypeSymbol = nil then begin
FTypeSymbol := TPasParserSymbolPointer.Create(FSourceTypeSymbol, FExpressionPart, FRefLevel); FTypeSymbol := TPasParserSymbolPointer.Create(FSourceTypeSymbol, FContext, FExprPos, FExprText, FRefLevel);
{$IFDEF WITH_REFCOUNT_DEBUG}FTypeSymbol.DbgRenameReference(@FSourceTypeSymbol, 'TPasParserSymbolValueMakeReftype'){$ENDIF}; {$IFDEF WITH_REFCOUNT_DEBUG}FTypeSymbol.DbgRenameReference(@FSourceTypeSymbol, 'TPasParserSymbolValueMakeReftype'){$ENDIF};
end; end;
Result := FTypeSymbol; Result := FTypeSymbol;
@ -1633,7 +1658,7 @@ begin
if FValue.TypeInfo = nil then if FValue.TypeInfo = nil then
exit; exit;
FTypeInfo := TPasParserSymbolPointer.Create(FValue.TypeInfo, FExpressionPart); FTypeInfo := TPasParserSymbolPointer.Create(FValue.TypeInfo, FContext, FExprPos, FExprText, 1);
{$IFDEF WITH_REFCOUNT_DEBUG}FTypeInfo.DbgRenameReference(@FTypeInfo, 'TPasParserAddressOfSymbolValue');{$ENDIF} {$IFDEF WITH_REFCOUNT_DEBUG}FTypeInfo.DbgRenameReference(@FTypeInfo, 'TPasParserAddressOfSymbolValue');{$ENDIF}
Result := FTypeInfo; Result := FTypeInfo;
end; end;
@ -1900,10 +1925,8 @@ begin
Result := inherited GetNestedSymbol(AIndex + 1); Result := inherited GetNestedSymbol(AIndex + 1);
end; end;
constructor TPasParserSymbolArrayDeIndex.Create( constructor TPasParserSymbolArrayDeIndex.Create(const AnArray: TFpSymbol);
AnExpressionPart: TFpPascalExpressionPart; const AnArray: TFpSymbol);
begin begin
FExpressionPart := AnExpressionPart;
FArray := AnArray; FArray := AnArray;
FArray.AddReference; FArray.AddReference;
inherited Create(''); inherited Create('');
@ -1928,7 +1951,7 @@ begin
exit; exit;
end; end;
assert(FPointerLevels > 1, 'TPasParserSymbolPointer.TypeInfoNeeded: FPointerLevels > 1'); assert(FPointerLevels > 1, 'TPasParserSymbolPointer.TypeInfoNeeded: FPointerLevels > 1');
t := TPasParserSymbolPointer.Create(FPointedTo, FExpressionPart, FPointerLevels-1); t := TPasParserSymbolPointer.Create(FPointedTo, FContext, FExprPos, FExprText, FPointerLevels-1);
SetTypeInfo(t); SetTypeInfo(t);
t.ReleaseReference; t.ReleaseReference;
end; end;
@ -1941,11 +1964,13 @@ begin
end; end;
constructor TPasParserSymbolPointer.Create(const APointedTo: TFpSymbol; constructor TPasParserSymbolPointer.Create(const APointedTo: TFpSymbol;
AnExpressionPart: TFpPascalExpressionPart; APointerLevels: Integer); AContext: TFpDbgSimpleLocationContext; AnExprPos: Integer; AnExprText: String;
APointerLevels: Integer);
begin begin
FContext := AContext;
FExprPos := AnExprPos;
FExprText := AnExprText;
inherited Create(''); inherited Create('');
FExpressionPart := AnExpressionPart;
FContext := FExpressionPart.ExpressionData.Scope.LocationContext;
FPointerLevels := APointerLevels; FPointerLevels := APointerLevels;
FPointedTo := APointedTo; FPointedTo := APointedTo;
FPointedTo.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(FPointedTo, 'TPasParserSymbolPointer'){$ENDIF}; FPointedTo.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(FPointedTo, 'TPasParserSymbolPointer'){$ENDIF};
@ -1955,6 +1980,15 @@ begin
SetSymbolType(stType); SetSymbolType(stType);
end; end;
constructor TPasParserSymbolPointer.Create(const APointedTo: TFpSymbol;
AnExpressionPart: TFpPascalExpressionPart; APointerLevels: Integer);
begin
Create(APointedTo, AnExpressionPart.ExpressionData.Scope.LocationContext,
AnExpressionPart.GetPos, AnExpressionPart.GetText(MAX_ERR_EXPR_QUOTE_LEN),
APointerLevels
);
end;
constructor TPasParserSymbolPointer.Create(const APointedTo: TFpSymbol; constructor TPasParserSymbolPointer.Create(const APointedTo: TFpSymbol;
AnExpressionPart: TFpPascalExpressionPart); AnExpressionPart: TFpPascalExpressionPart);
begin begin
@ -1969,7 +2003,7 @@ end;
function TPasParserSymbolPointer.TypeCastValue(AValue: TFpValue): TFpValue; function TPasParserSymbolPointer.TypeCastValue(AValue: TFpValue): TFpValue;
begin begin
Result := TFpPasParserValueCastToPointer.Create(AValue, Self, FExpressionPart); Result := TFpPasParserValueCastToPointer.Create(AValue, Self, FContext, FExprPos, FExprText );
end; end;
@ -7442,7 +7476,7 @@ begin
// Some evaluation errors (such as deref nil) are marked on the Expression, // Some evaluation errors (such as deref nil) are marked on the Expression,
// rather than on the value(s). // rather than on the value(s).
// If this code is called, the Expression should have been valid before. // If this code is called, the Expression should have been valid before.
FExpressionPart.ExpressionData.ClearError; FExpressionPartInValue.ExpressionData.ClearError;
end; end;
Result := FArraySlice.Items[0].ResultValue; Result := FArraySlice.Items[0].ResultValue;
@ -7456,7 +7490,7 @@ begin
Result.Flags := Result.Flags + [vfVariant]; Result.Flags := Result.Flags + [vfVariant];
end; end;
FExpressionPart.ExpressionData.ClearError; FExpressionPartInValue.ExpressionData.ClearError;
end; end;
function TFpPasParserValueSlicedArray.GetMemberCount: Integer; function TFpPasParserValueSlicedArray.GetMemberCount: Integer;
@ -7482,6 +7516,7 @@ end;
constructor TFpPasParserValueSlicedArray.Create( constructor TFpPasParserValueSlicedArray.Create(
ASlice: TFpPascalExpressionPartOperatorArraySliceController; AnOwnsController: boolean); ASlice: TFpPascalExpressionPartOperatorArraySliceController; AnOwnsController: boolean);
begin begin
FExpressionPartInValue := ASlice;
inherited Create(ASlice); inherited Create(ASlice);
FArraySlice := ASlice; FArraySlice := ASlice;
FOwnsController := AnOwnsController; FOwnsController := AnOwnsController;