From 1c008e121d01b9046e18acce155a5acb6a598961 Mon Sep 17 00:00:00 2001 From: Martin Date: Mon, 27 Jun 2022 22:34:08 +0200 Subject: [PATCH] Debugger: improve SysVarToLStr - convert fields of structures too / array in Inspector --- components/fpdebug/fpwatchresultdata.pas | 109 ++++++++------- .../fpdebugdebuggerworkthreads.pas | 61 +++------ .../lazdebuggerfp/fpdebuggerresultdata.pas | 126 ++++++++++++++++++ .../lazdebuggerfp/fpdebugvalueconvertors.pas | 17 +-- .../lazdebuggerfp/lazdebuggerfp.lpk | 4 + .../lazdebuggerfp/lazdebuggerfp.pas | 3 +- 6 files changed, 218 insertions(+), 102 deletions(-) create mode 100644 components/lazdebuggers/lazdebuggerfp/fpdebuggerresultdata.pas diff --git a/components/fpdebug/fpwatchresultdata.pas b/components/fpdebug/fpwatchresultdata.pas index 55acf6e2bd..99c41c0389 100644 --- a/components/fpdebug/fpwatchresultdata.pas +++ b/components/fpdebug/fpwatchresultdata.pas @@ -57,6 +57,9 @@ type function ProcToResData(AnFpValue: TFpValue; AnResData: TLzDbgWatchDataIntf): Boolean; + function DoValueToResData(AnFpValue: TFpValue; + AnResData: TLzDbgWatchDataIntf + ): Boolean; virtual; function DoWriteWatchResultData(AnFpValue: TFpValue; AnResData: TLzDbgWatchDataIntf ): Boolean; @@ -64,6 +67,8 @@ type AnResData: TLzDbgWatchDataIntf; AnAddr: TDbgPtr ): Boolean; + + property RecurseCnt: Integer read FRecurseCnt; public constructor Create(AContext: TFpDbgLocationContext); destructor Destroy; override; @@ -590,11 +595,65 @@ begin AddTypeNameToResData(AnFpValue, AnResData); end; -function TFpWatchResultConvertor.DoWriteWatchResultData(AnFpValue: TFpValue; +function TFpWatchResultConvertor.DoValueToResData(AnFpValue: TFpValue; AnResData: TLzDbgWatchDataIntf): Boolean; var PrettyPrinter: TFpPascalPrettyPrinter; s: String; +begin + Result := False; + case AnFpValue.Kind of + skPointer: Result := PointerToResData(AnFpValue, AnResData); + skInteger, + skCardinal: Result := NumToResData(AnFpValue, AnResData); + skFloat: Result := FloatToResData(AnFpValue, AnResData); + + skChar: Result := CharToResData(AnFpValue, AnResData); + skString, + skAnsiString: Result := StringToResData(AnFpValue, AnResData); + skWideString: Result := WideStringToResData(AnFpValue, AnResData); + + skRecord, + skObject, + skClass, + skInterface: Result := StructToResData(AnFpValue, AnResData); + + skNone: ; + skType: ; + skInstance: ; + skUnit: ; + skProcedure, + skFunction, + skProcedureRef, + skFunctionRef: Result := ProcToResData(AnFpValue, AnResData); + skSimple: ; + skBoolean: Result := BoolToResData(AnFpValue, AnResData); + skCurrency: ; + skVariant: ; + skEnum, + skEnumValue: Result := EnumToResData(AnFpValue, AnResData); + skSet: Result := SetToResData(AnFpValue, AnResData); + skArray: Result := ArrayToResData(AnFpValue, AnResData); + skRegister: ; + skAddress: ; + end; + if Result then + CheckError(AnFpValue, AnResData) + else + if FRecurseCnt > 0 then begin + PrettyPrinter := TFpPascalPrettyPrinter.Create(Context.SizeOfAddress); + PrettyPrinter.Context := Context; + PrettyPrinter.PrintValue(s, AnFpValue, wdfDefault, 1, [], [ppvSkipClassBody]); + AnResData.CreatePrePrinted(s); + PrettyPrinter.Free; + Result := True; + end; + +end; + +function TFpWatchResultConvertor.DoWriteWatchResultData(AnFpValue: TFpValue; + AnResData: TLzDbgWatchDataIntf): Boolean; +var DidHaveEmbeddedPointer: Boolean; begin // FRecurseCnt should be handled by the caller @@ -621,55 +680,9 @@ begin exit(True); // not an error // Allow only one level, after an embedded pointer (pointer nested in other data-type) end; - FLastValueKind := AnFpValue.Kind; try - case AnFpValue.Kind of - skPointer: Result := PointerToResData(AnFpValue, AnResData); - skInteger, - skCardinal: Result := NumToResData(AnFpValue, AnResData); - skFloat: Result := FloatToResData(AnFpValue, AnResData); - - skChar: Result := CharToResData(AnFpValue, AnResData); - skString, - skAnsiString: Result := StringToResData(AnFpValue, AnResData); - skWideString: Result := WideStringToResData(AnFpValue, AnResData); - - skRecord, - skObject, - skClass, - skInterface: Result := StructToResData(AnFpValue, AnResData); - - skNone: ; - skType: ; - skInstance: ; - skUnit: ; - skProcedure, - skFunction, - skProcedureRef, - skFunctionRef: Result := ProcToResData(AnFpValue, AnResData); - skSimple: ; - skBoolean: Result := BoolToResData(AnFpValue, AnResData); - skCurrency: ; - skVariant: ; - skEnum, - skEnumValue: Result := EnumToResData(AnFpValue, AnResData); - skSet: Result := SetToResData(AnFpValue, AnResData); - skArray: Result := ArrayToResData(AnFpValue, AnResData); - skRegister: ; - skAddress: ; - end; - if Result then - CheckError(AnFpValue, AnResData) - else - if FRecurseCnt > 0 then begin - PrettyPrinter := TFpPascalPrettyPrinter.Create(Context.SizeOfAddress); - PrettyPrinter.Context := Context; - PrettyPrinter.PrintValue(s, AnFpValue, wdfDefault, 1, [], [ppvSkipClassBody]); - AnResData.CreatePrePrinted(s); - PrettyPrinter.Free; - Result := True; - end; + Result := DoValueToResData(AnFpValue, AnResData); finally if FRecursePointerCnt > 0 then dec(FRecursePointerCnt) diff --git a/components/lazdebuggers/lazdebuggerfp/fpdebugdebuggerworkthreads.pas b/components/lazdebuggers/lazdebuggerfp/fpdebugdebuggerworkthreads.pas index 3463144a14..7bc7c8b51b 100644 --- a/components/lazdebuggers/lazdebuggerfp/fpdebugdebuggerworkthreads.pas +++ b/components/lazdebuggers/lazdebuggerfp/fpdebugdebuggerworkthreads.pas @@ -47,9 +47,10 @@ interface uses FpDebugDebuggerUtils, FpDebugValueConvertors, DbgIntfDebuggerBase, DbgIntfBaseTypes, FpDbgClasses, FpDbgUtil, FPDbgController, FpPascalBuilder, - FpdMemoryTools, FpDbgInfo, FpPascalParser, FpErrorMessages, FpDebugDebuggerBase, - FpDbgCallContextInfo, FpDbgDwarf, FpDbgDwarfDataClasses, FpWatchResultData, - LazDebuggerIntf, Forms, fgl, math, Classes, sysutils, LazClasses, + FpdMemoryTools, FpDbgInfo, FpPascalParser, FpErrorMessages, + FpDebugDebuggerBase, FpDebuggerResultData, FpDbgCallContextInfo, FpDbgDwarf, + FpDbgDwarfDataClasses, FpWatchResultData, LazDebuggerIntf, Forms, fgl, math, + Classes, sysutils, LazClasses, {$ifdef FORCE_LAZLOGGER_DUMMY} LazLoggerDummy {$else} LazLoggerBase {$endif}; type @@ -1039,20 +1040,16 @@ function TFpThreadWorkerEvaluate.EvaluateExpression(const AnExpression: String; var APasExpr, PasExpr2: TFpPascalExpression; PrettyPrinter: TFpPascalPrettyPrinter; - ResValue, NewRes: TFpValue; + ResValue: TFpValue; CastName, ResText2: String; - WatchResConv: TFpWatchResultConvertor; + WatchResConv: TFpLazDbgWatchResultConvertor; ResData: TLzDbgWatchDataIntf; - ValConvList: TFpDbgConverterConfigList; - ValConv: TFpDbgValueConverter; i: Integer; ValConfig: TFpDbgConverterConfig; begin Result := False; AResText := ''; ATypeInfo := nil; - NewRes := nil; - ValConv := nil; FExpressionScope := FDebugger.DbgController.CurrentProcess.FindSymbolScope(AThreadId, AStackFrame); if FExpressionScope = nil then begin @@ -1117,45 +1114,21 @@ begin exit; end; - if (FWatchValue <> nil) and (ADispFormat <> wdfMemDump) and - (not (defSkipValConv in AnEvalFlags)) and - (ResValue <> nil) and (ResValue.TypeInfo <> nil) - then begin - ValConfig := TFpDbgConverterConfig(FWatchValue.GetFpDbgConverter); - if (ValConfig <> nil) and (ValConfig.CheckMatch(ResValue)) then begin - ValConv := ValConfig.Converter; - ValConv.AddReference; - end; - - if (ValConv = nil) and (ValConfig = nil) then begin - ValConvList := ValueConverterConfigList; - ValConvList.Lock; - try - i := ValConvList.Count - 1; - while (i >= 0) and (not ValConvList[i].CheckMatch(ResValue)) do - dec(i); - if i >= 0 then begin - ValConv := ValConvList[i].Converter; - ValConv.AddReference; - end; - finally - ValConvList.Unlock; - end; - end; - - if ValConv <> nil then begin - NewRes := ValConv.ConvertValue(ResValue, FDebugger, FExpressionScope); - if NewRes <> nil then - ResValue := NewRes; - end; - end; - if (FWatchValue <> nil) and (ResValue <> nil) and (ADispFormat <> wdfMemDump) // TODO then begin - WatchResConv := TFpWatchResultConvertor.Create(FExpressionScope.LocationContext); + WatchResConv := TFpLazDbgWatchResultConvertor.Create(FExpressionScope.LocationContext); WatchResConv.ExtraDepth := defExtraDepth in FWatchValue.EvaluateFlags; WatchResConv.FirstIndexOffs := FWatchValue.FirstIndexOffs; + if not (defSkipValConv in AnEvalFlags) then begin + ValConfig := TFpDbgConverterConfig(FWatchValue.GetFpDbgConverter); + if ValConfig <> nil then + WatchResConv.ValConfig := ValConfig + else + WatchResConv.ValConvList := ValueConverterConfigList; + WatchResConv.Debugger := FDebugger; + end; + WatchResConv.ExpressionScope := FExpressionScope; ResData := FWatchValue.ResData; Result := WatchResConv.WriteWatchResultData(ResValue, ResData, FWatchValue.RepeatCount); @@ -1209,9 +1182,7 @@ begin finally PrettyPrinter.Free; APasExpr.Free; - NewRes.ReleaseReference; FExpressionScope.ReleaseReference; - ValConv.ReleaseReference; end; end; diff --git a/components/lazdebuggers/lazdebuggerfp/fpdebuggerresultdata.pas b/components/lazdebuggers/lazdebuggerfp/fpdebuggerresultdata.pas new file mode 100644 index 0000000000..496f2fdce5 --- /dev/null +++ b/components/lazdebuggers/lazdebuggerfp/fpdebuggerresultdata.pas @@ -0,0 +1,126 @@ +unit FpDebuggerResultData; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FpWatchResultData, FpDbgInfo, DbgIntfBaseTypes, + FpDebugValueConvertors, FpDebugDebuggerBase, LazDebuggerIntf; + +type + + { TFpLazDbgWatchResultConvertor } + + TFpLazDbgWatchResultConvertor = class(TFpWatchResultConvertor) + private + FDebugger: TFpDebugDebuggerBase; + FExpressionScope: TFpDbgSymbolScope; + FValConvList: TFpDbgConverterConfigList; + FValConfig: TFpDbgConverterConfig; + + FOuterKind: TDbgSymbolKind; + FMainValueIsArray: Boolean; + FArrayItemConv: TFpDbgValueConverter; + + function GetValConv(AnFpValue: TFpValue): TFpDbgValueConverter; inline; + public + destructor Destroy; override; + + function DoValueToResData(AnFpValue: TFpValue; + AnResData: TLzDbgWatchDataIntf): Boolean; override; + property ValConvList: TFpDbgConverterConfigList read FValConvList write FValConvList; + property ValConfig: TFpDbgConverterConfig read FValConfig write FValConfig; + property Debugger: TFpDebugDebuggerBase read FDebugger write FDebugger; + property ExpressionScope: TFpDbgSymbolScope read FExpressionScope write FExpressionScope; + end; + +implementation + +{ TFpLazDbgWatchResultConvertor } + +function TFpLazDbgWatchResultConvertor.GetValConv(AnFpValue: TFpValue + ): TFpDbgValueConverter; +var + i: Integer; +begin + Result := nil; + if (ValConfig <> nil) then begin + if ValConfig.CheckMatch(AnFpValue) then + Result := ValConfig.Converter; + if Result <> nil then + Result.AddReference; + end; + if (ValConvList <> nil) then begin + ValConvList.Lock; + try + i := ValConvList.Count - 1; + while (i >= 0) and (not ValConvList[i].CheckMatch(AnFpValue)) do + dec(i); + if i >= 0 then + Result := ValConvList[i].Converter; + if Result <> nil then + Result.AddReference; + finally + ValConvList.Unlock; + end; + end; +end; + +destructor TFpLazDbgWatchResultConvertor.Destroy; +begin + inherited Destroy; + FArrayItemConv.ReleaseReference; +end; + +function TFpLazDbgWatchResultConvertor.DoValueToResData(AnFpValue: TFpValue; + AnResData: TLzDbgWatchDataIntf): Boolean; +var + NewRes: TFpValue; + CurConv: TFpDbgValueConverter; +begin + NewRes := nil; + if RecurseCnt = 0 then + FOuterKind := AnFpValue.Kind; + + if (RecurseCnt =-1) and (AnFpValue.Kind in [skArray]) then + FMainValueIsArray := True; + + CurConv := nil; + try + if (RecurseCnt = 0) and (FMainValueIsArray) then begin + if FArrayItemConv = nil then + FArrayItemConv := GetValConv(AnFpValue); + CurConv := FArrayItemConv; + end + else + if (not FMainValueIsArray) and + ( (RecurseCnt = 0) or + ( (RecurseCnt = 1) and (FOuterKind in [skClass, skRecord, skObject, skInstance, skInterface]) ) + ) + then begin + CurConv := GetValConv(AnFpValue); + end; + + if (CurConv <> nil) then begin + NewRes := CurConv.ConvertValue(AnFpValue, Debugger, ExpressionScope); + if NewRes <> nil then + AnFpValue := NewRes + else + if FMainValueIsArray then begin + AnResData.CreateError('Conversion failed'); + Result := True; + exit; + end; + end; + if CurConv <> FArrayItemConv then + CurConv.ReleaseReference; + + Result := inherited DoValueToResData(AnFpValue, AnResData); + finally + NewRes.ReleaseReference; + end; +end; + +end. + diff --git a/components/lazdebuggers/lazdebuggerfp/fpdebugvalueconvertors.pas b/components/lazdebuggers/lazdebuggerfp/fpdebugvalueconvertors.pas index cb3c0639d4..20ff2e37dd 100644 --- a/components/lazdebuggers/lazdebuggerfp/fpdebugvalueconvertors.pas +++ b/components/lazdebuggers/lazdebuggerfp/fpdebugvalueconvertors.pas @@ -299,21 +299,21 @@ var ProcLoc: TFpDbgMemLocation; begin Result := nil; + if (ASourceValue.Kind <> skRecord) //or + //(ASourceValue.MemberCount <> 2) or + //(SizeToFullBytes(ASourceValue.Member[0].DataSize) <> 2) + then + exit; ProcVal := nil; ProcSym := nil; StringDecRefSymbol := nil; try (* -VARIANTS_$$_SYSVARTOLSTR$ANSISTRING$VARIANT -U_$SYSTEM_$$_VARIANTMANAGER + //VARIANTS_$$_SYSVARTOLSTR$ANSISTRING$VARIANT + //U_$SYSTEM_$$_VARIANTMANAGER + //SYSTEM_$$_GETVARIANTMANAGER$TVARIANTMANAGER - -SYSTEM_$$_GETVARIANTMANAGER$TVARIANTMANAGER - -*) - -(* ProcVal := AnExpressionScope.FindSymbol('sysvartolstr', 'variants'); if ProcVal <> nil then begin ProcSym := ProcVal.DbgSymbol; @@ -330,6 +330,7 @@ SYSTEM_$$_GETVARIANTMANAGER$TVARIANTMANAGER ProcLoc := ProcSym.Address *) + if not IsTargetAddr(ASourceValue.Address) then exit; diff --git a/components/lazdebuggers/lazdebuggerfp/lazdebuggerfp.lpk b/components/lazdebuggers/lazdebuggerfp/lazdebuggerfp.lpk index feb35e95f4..95b58f3dfe 100644 --- a/components/lazdebuggers/lazdebuggerfp/lazdebuggerfp.lpk +++ b/components/lazdebuggers/lazdebuggerfp/lazdebuggerfp.lpk @@ -44,6 +44,10 @@ + + + + diff --git a/components/lazdebuggers/lazdebuggerfp/lazdebuggerfp.pas b/components/lazdebuggers/lazdebuggerfp/lazdebuggerfp.pas index c6eaf0ad2c..f343fe7795 100644 --- a/components/lazdebuggers/lazdebuggerfp/lazdebuggerfp.pas +++ b/components/lazdebuggers/lazdebuggerfp/lazdebuggerfp.pas @@ -9,7 +9,8 @@ interface uses FpDebugDebugger, FpDebugDebuggerUtils, FpDebugDebuggerWorkThreads, - FpDebugValueConvertors, FpDebugDebuggerBase, LazarusPackageIntf; + FpDebugValueConvertors, FpDebugDebuggerBase, FpDebuggerResultData, + LazarusPackageIntf; implementation