paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-07 04:18:48 +02:00
Code Issues Packages Projects Releases Wiki Activity

FpDebugger: fix value-converters crash in array. Arrays elements must have a static type, and must not depend on the instance.

Browse Source
This commit is contained in:
Martin 2022-08-23 16:07:04 +02:00
parent 9147be77ec
commit 1c5a6ca5d7
3 changed files with 35 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
components/fpdebug/fpwatchresultdata.pas
View File

@ -69,6 +69,7 @@ type
): Boolean;
property RecurseCnt: Integer read FRecurseCnt;
property RecurseCntLow: Integer read FRecurseCntLow;
public
constructor Create(AContext: TFpDbgLocationContext);
destructor Destroy; override;
@ -590,7 +591,7 @@ begin
end;
ResAnch := nil;
ti := MemberValue.ParentTypeInfo;
ti := MemberValue.ParentTypeInfo; // TODO: variant returens nil, membervalue.sturcturevalue.parenttypesymbol
if ti <> nil then
ti := ti.InternalTypeInfo;
j := AnchestorMap.IndexOf(PtrUInt(ti));

16
components/lazdebuggers/lazdebuggerfp/fpdebuggerresultdata.pas
View File

@ -29,7 +29,7 @@ type
FMaxTotalConv, FMaxArrayConv, FCurMaxArrayConv: Integer;
FNoConvert: Boolean;
function GetValConv(AnFpValue: TFpValue): TFpDbgValueConverter; inline;
function GetValConv(AnFpValue: TFpValue; IgnoreInstanceClass: boolean = False): TFpDbgValueConverter; inline;
procedure SetMaxArrayConv(AValue: Integer);
procedure SetMaxTotalConv(AValue: Integer);
public
@ -50,8 +50,8 @@ implementation
{ TFpLazDbgWatchResultConvertor }
function TFpLazDbgWatchResultConvertor.GetValConv(AnFpValue: TFpValue
): TFpDbgValueConverter;
function TFpLazDbgWatchResultConvertor.GetValConv(AnFpValue: TFpValue;
IgnoreInstanceClass: boolean): TFpDbgValueConverter;
var
i: Integer;
begin
@ -62,7 +62,7 @@ begin
exit;
if (ValConfig <> nil) then begin
if ValConfig.CheckMatch(AnFpValue) then
if ValConfig.CheckMatch(AnFpValue, IgnoreInstanceClass) then
Result := ValConfig.GetConverter.GetObject as TFpDbgValueConverter;
if Result <> nil then
Result.AddReference;
@ -72,7 +72,7 @@ begin
ValConvList.Lock;
try
i := ValConvList.Count - 1;
while (i >= 0) and (not ValConvList[i].CheckMatch(AnFpValue)) do
while (i >= 0) and (not ValConvList[i].CheckMatch(AnFpValue, IgnoreInstanceClass)) do
dec(i);
if i >= 0 then
Result := ValConvList[i].GetConverter.GetObject as TFpDbgValueConverter;
@ -137,7 +137,7 @@ begin
try
if (RecurseCnt = 0) and (FExtraDephtLevelIsArray) then begin
if FExtraDephtLevelItemConv = nil then
FExtraDephtLevelItemConv := GetValConv(AnFpValue);
FExtraDephtLevelItemConv := GetValConv(AnFpValue, RecurseCnt <> RecurseCntLow);
CurConv := FExtraDephtLevelItemConv;
if CurConv <> nil then
CurConv.AddReference;
@ -145,13 +145,13 @@ begin
else
if (RecurseCnt = 1) and (FLevelZeroKind = skArray) then begin
if FLevelZeroArrayConv = nil then
FLevelZeroArrayConv := GetValConv(AnFpValue);
FLevelZeroArrayConv := GetValConv(AnFpValue, RecurseCnt <> RecurseCntLow);
CurConv := FLevelZeroArrayConv;
if CurConv <> nil then
CurConv.AddReference;
end
else begin
CurConv := GetValConv(AnFpValue);
CurConv := GetValConv(AnFpValue, RecurseCnt <> RecurseCntLow);
end;
if (CurConv <> nil) then begin

48
components/lazdebuggers/lazdebuggerfp/fpdebugvalueconvertors.pas
View File

@ -45,8 +45,8 @@ type
{ TFpDbgValueConvertSelectorIntfHelper }
TFpDbgValueConvertSelectorIntfHelper = type helper for TLazDbgValueConvertSelectorIntf
function CheckMatch(AValue: TFpValue): Boolean;
function CheckTypeMatch(AValue: TFpValue): Boolean;
function CheckMatch(AValue: TFpValue; IgnoreInstanceClass: boolean = False): Boolean;
function CheckTypeMatch(AValue: TFpValue; IgnoreInstanceClass: boolean = False): Boolean;
end;
{ TFpDbgValueConverterRegistryEntry }
@ -131,15 +131,15 @@ end;
{ TFpDbgValueConvertSelectorIntfHelper }
function TFpDbgValueConvertSelectorIntfHelper.CheckMatch(AValue: TFpValue
): Boolean;
function TFpDbgValueConvertSelectorIntfHelper.CheckMatch(AValue: TFpValue;
IgnoreInstanceClass: boolean): Boolean;
begin
Result := //(AValue.Kind in (MatchKinds * GetConverter.GetSupportedKinds)) and
CheckTypeMatch(AValue);
CheckTypeMatch(AValue, IgnoreInstanceClass);
end;
function TFpDbgValueConvertSelectorIntfHelper.CheckTypeMatch(AValue: TFpValue
): Boolean;
function TFpDbgValueConvertSelectorIntfHelper.CheckTypeMatch(AValue: TFpValue;
IgnoreInstanceClass: boolean): Boolean;
function MatchPattern(const AName, APattern: String): Boolean;
var
NamePos, PatternPos, p: Integer;
@ -218,25 +218,27 @@ begin
ValClassName := LowerCase(ValClassName);
end;
CnIdx := 0;
while AValue.GetInstanceClassName(@ValClassName, @ValUnitName, CnIdx) and
(ValClassName <> '')
do begin
ValClassName := LowerCase(ValClassName);
if (ValClassName = TpName) and (not HasMaybeUnitDot) then
Break;
Result := MatchPattern(ValClassName, Pattern);
if Result then
exit;
if HasMaybeUnitDot and (ValUnitName <> '') then begin
ValUnitName := LowerCase(ValUnitName);
Result := MatchPattern(ValUnitName+'.'+ValClassName, Pattern);
if not IgnoreInstanceClass then begin
CnIdx := 0;
while AValue.GetInstanceClassName(@ValClassName, @ValUnitName, CnIdx) and
(ValClassName <> '')
do begin
ValClassName := LowerCase(ValClassName);
if (ValClassName = TpName) and (not HasMaybeUnitDot) then
Break;
Result := MatchPattern(ValClassName, Pattern);
if Result then
exit;
end;
inc(CnIdx);
if HasMaybeUnitDot and (ValUnitName <> '') then begin
ValUnitName := LowerCase(ValUnitName);
Result := MatchPattern(ValUnitName+'.'+ValClassName, Pattern);
if Result then
exit;
end;
inc(CnIdx);
end;
end;
AValue.ResetError;