From 1c5a6ca5d7fb8965e7afb317be555f38190488ba Mon Sep 17 00:00:00 2001 From: Martin Date: Tue, 23 Aug 2022 16:07:04 +0200 Subject: [PATCH] FpDebugger: fix value-converters crash in array. Arrays elements must have a static type, and must not depend on the instance. --- components/fpdebug/fpwatchresultdata.pas | 3 +- .../lazdebuggerfp/fpdebuggerresultdata.pas | 16 +++---- .../lazdebuggerfp/fpdebugvalueconvertors.pas | 48 ++++++++++--------- 3 files changed, 35 insertions(+), 32 deletions(-) diff --git a/components/fpdebug/fpwatchresultdata.pas b/components/fpdebug/fpwatchresultdata.pas index 0f3e566ba2..b4897963ff 100644 --- a/components/fpdebug/fpwatchresultdata.pas +++ b/components/fpdebug/fpwatchresultdata.pas @@ -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)); diff --git a/components/lazdebuggers/lazdebuggerfp/fpdebuggerresultdata.pas b/components/lazdebuggers/lazdebuggerfp/fpdebuggerresultdata.pas index 230008f595..df7dda25f8 100644 --- a/components/lazdebuggers/lazdebuggerfp/fpdebuggerresultdata.pas +++ b/components/lazdebuggers/lazdebuggerfp/fpdebuggerresultdata.pas @@ -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 diff --git a/components/lazdebuggers/lazdebuggerfp/fpdebugvalueconvertors.pas b/components/lazdebuggers/lazdebuggerfp/fpdebugvalueconvertors.pas index 18e67ae2e0..d3096012e4 100644 --- a/components/lazdebuggers/lazdebuggerfp/fpdebugvalueconvertors.pas +++ b/components/lazdebuggers/lazdebuggerfp/fpdebugvalueconvertors.pas @@ -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;