Debugger: improve SysVarToLStr - convert fields of structures too / array in Inspector

This commit is contained in:
Martin 2022-06-27 22:34:08 +02:00
parent 73bad58fd3
commit 1c008e121d
6 changed files with 218 additions and 102 deletions

View File

@ -57,6 +57,9 @@ type
function ProcToResData(AnFpValue: TFpValue; AnResData: TLzDbgWatchDataIntf): Boolean; function ProcToResData(AnFpValue: TFpValue; AnResData: TLzDbgWatchDataIntf): Boolean;
function DoValueToResData(AnFpValue: TFpValue;
AnResData: TLzDbgWatchDataIntf
): Boolean; virtual;
function DoWriteWatchResultData(AnFpValue: TFpValue; function DoWriteWatchResultData(AnFpValue: TFpValue;
AnResData: TLzDbgWatchDataIntf AnResData: TLzDbgWatchDataIntf
): Boolean; ): Boolean;
@ -64,6 +67,8 @@ type
AnResData: TLzDbgWatchDataIntf; AnResData: TLzDbgWatchDataIntf;
AnAddr: TDbgPtr AnAddr: TDbgPtr
): Boolean; ): Boolean;
property RecurseCnt: Integer read FRecurseCnt;
public public
constructor Create(AContext: TFpDbgLocationContext); constructor Create(AContext: TFpDbgLocationContext);
destructor Destroy; override; destructor Destroy; override;
@ -590,11 +595,65 @@ begin
AddTypeNameToResData(AnFpValue, AnResData); AddTypeNameToResData(AnFpValue, AnResData);
end; end;
function TFpWatchResultConvertor.DoWriteWatchResultData(AnFpValue: TFpValue; function TFpWatchResultConvertor.DoValueToResData(AnFpValue: TFpValue;
AnResData: TLzDbgWatchDataIntf): Boolean; AnResData: TLzDbgWatchDataIntf): Boolean;
var var
PrettyPrinter: TFpPascalPrettyPrinter; PrettyPrinter: TFpPascalPrettyPrinter;
s: String; 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; DidHaveEmbeddedPointer: Boolean;
begin begin
// FRecurseCnt should be handled by the caller // FRecurseCnt should be handled by the caller
@ -621,55 +680,9 @@ begin
exit(True); // not an error exit(True); // not an error
// Allow only one level, after an embedded pointer (pointer nested in other data-type) // Allow only one level, after an embedded pointer (pointer nested in other data-type)
end; end;
FLastValueKind := AnFpValue.Kind; FLastValueKind := AnFpValue.Kind;
try try
case AnFpValue.Kind of Result := DoValueToResData(AnFpValue, AnResData);
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;
finally finally
if FRecursePointerCnt > 0 then if FRecursePointerCnt > 0 then
dec(FRecursePointerCnt) dec(FRecursePointerCnt)

View File

@ -47,9 +47,10 @@ interface
uses uses
FpDebugDebuggerUtils, FpDebugValueConvertors, DbgIntfDebuggerBase, FpDebugDebuggerUtils, FpDebugValueConvertors, DbgIntfDebuggerBase,
DbgIntfBaseTypes, FpDbgClasses, FpDbgUtil, FPDbgController, FpPascalBuilder, DbgIntfBaseTypes, FpDbgClasses, FpDbgUtil, FPDbgController, FpPascalBuilder,
FpdMemoryTools, FpDbgInfo, FpPascalParser, FpErrorMessages, FpDebugDebuggerBase, FpdMemoryTools, FpDbgInfo, FpPascalParser, FpErrorMessages,
FpDbgCallContextInfo, FpDbgDwarf, FpDbgDwarfDataClasses, FpWatchResultData, FpDebugDebuggerBase, FpDebuggerResultData, FpDbgCallContextInfo, FpDbgDwarf,
LazDebuggerIntf, Forms, fgl, math, Classes, sysutils, LazClasses, FpDbgDwarfDataClasses, FpWatchResultData, LazDebuggerIntf, Forms, fgl, math,
Classes, sysutils, LazClasses,
{$ifdef FORCE_LAZLOGGER_DUMMY} LazLoggerDummy {$else} LazLoggerBase {$endif}; {$ifdef FORCE_LAZLOGGER_DUMMY} LazLoggerDummy {$else} LazLoggerBase {$endif};
type type
@ -1039,20 +1040,16 @@ function TFpThreadWorkerEvaluate.EvaluateExpression(const AnExpression: String;
var var
APasExpr, PasExpr2: TFpPascalExpression; APasExpr, PasExpr2: TFpPascalExpression;
PrettyPrinter: TFpPascalPrettyPrinter; PrettyPrinter: TFpPascalPrettyPrinter;
ResValue, NewRes: TFpValue; ResValue: TFpValue;
CastName, ResText2: String; CastName, ResText2: String;
WatchResConv: TFpWatchResultConvertor; WatchResConv: TFpLazDbgWatchResultConvertor;
ResData: TLzDbgWatchDataIntf; ResData: TLzDbgWatchDataIntf;
ValConvList: TFpDbgConverterConfigList;
ValConv: TFpDbgValueConverter;
i: Integer; i: Integer;
ValConfig: TFpDbgConverterConfig; ValConfig: TFpDbgConverterConfig;
begin begin
Result := False; Result := False;
AResText := ''; AResText := '';
ATypeInfo := nil; ATypeInfo := nil;
NewRes := nil;
ValConv := nil;
FExpressionScope := FDebugger.DbgController.CurrentProcess.FindSymbolScope(AThreadId, AStackFrame); FExpressionScope := FDebugger.DbgController.CurrentProcess.FindSymbolScope(AThreadId, AStackFrame);
if FExpressionScope = nil then begin if FExpressionScope = nil then begin
@ -1117,45 +1114,21 @@ begin
exit; exit;
end; 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 if (FWatchValue <> nil) and (ResValue <> nil) and
(ADispFormat <> wdfMemDump) // TODO (ADispFormat <> wdfMemDump) // TODO
then begin then begin
WatchResConv := TFpWatchResultConvertor.Create(FExpressionScope.LocationContext); WatchResConv := TFpLazDbgWatchResultConvertor.Create(FExpressionScope.LocationContext);
WatchResConv.ExtraDepth := defExtraDepth in FWatchValue.EvaluateFlags; WatchResConv.ExtraDepth := defExtraDepth in FWatchValue.EvaluateFlags;
WatchResConv.FirstIndexOffs := FWatchValue.FirstIndexOffs; 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; ResData := FWatchValue.ResData;
Result := WatchResConv.WriteWatchResultData(ResValue, ResData, FWatchValue.RepeatCount); Result := WatchResConv.WriteWatchResultData(ResValue, ResData, FWatchValue.RepeatCount);
@ -1209,9 +1182,7 @@ begin
finally finally
PrettyPrinter.Free; PrettyPrinter.Free;
APasExpr.Free; APasExpr.Free;
NewRes.ReleaseReference;
FExpressionScope.ReleaseReference; FExpressionScope.ReleaseReference;
ValConv.ReleaseReference;
end; end;
end; end;

View File

@ -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.

View File

@ -299,21 +299,21 @@ var
ProcLoc: TFpDbgMemLocation; ProcLoc: TFpDbgMemLocation;
begin begin
Result := nil; Result := nil;
if (ASourceValue.Kind <> skRecord) //or
//(ASourceValue.MemberCount <> 2) or
//(SizeToFullBytes(ASourceValue.Member[0].DataSize) <> 2)
then
exit;
ProcVal := nil; ProcVal := nil;
ProcSym := nil; ProcSym := nil;
StringDecRefSymbol := nil; StringDecRefSymbol := nil;
try try
(* (*
VARIANTS_$$_SYSVARTOLSTR$ANSISTRING$VARIANT //VARIANTS_$$_SYSVARTOLSTR$ANSISTRING$VARIANT
U_$SYSTEM_$$_VARIANTMANAGER //U_$SYSTEM_$$_VARIANTMANAGER
//SYSTEM_$$_GETVARIANTMANAGER$TVARIANTMANAGER
SYSTEM_$$_GETVARIANTMANAGER$TVARIANTMANAGER
*)
(*
ProcVal := AnExpressionScope.FindSymbol('sysvartolstr', 'variants'); ProcVal := AnExpressionScope.FindSymbol('sysvartolstr', 'variants');
if ProcVal <> nil then begin if ProcVal <> nil then begin
ProcSym := ProcVal.DbgSymbol; ProcSym := ProcVal.DbgSymbol;
@ -330,6 +330,7 @@ SYSTEM_$$_GETVARIANTMANAGER$TVARIANTMANAGER
ProcLoc := ProcSym.Address ProcLoc := ProcSym.Address
*) *)
if not IsTargetAddr(ASourceValue.Address) then if not IsTargetAddr(ASourceValue.Address) then
exit; exit;

View File

@ -44,6 +44,10 @@
<Filename Value="fpdebugdebuggerbase.pas"/> <Filename Value="fpdebugdebuggerbase.pas"/>
<UnitName Value="FpDebugDebuggerBase"/> <UnitName Value="FpDebugDebuggerBase"/>
</Item> </Item>
<Item>
<Filename Value="fpdebuggerresultdata.pas"/>
<UnitName Value="FpDebuggerResultData"/>
</Item>
</Files> </Files>
<RequiredPkgs> <RequiredPkgs>
<Item> <Item>

View File

@ -9,7 +9,8 @@ interface
uses uses
FpDebugDebugger, FpDebugDebuggerUtils, FpDebugDebuggerWorkThreads, FpDebugDebugger, FpDebugDebuggerUtils, FpDebugDebuggerWorkThreads,
FpDebugValueConvertors, FpDebugDebuggerBase, LazarusPackageIntf; FpDebugValueConvertors, FpDebugDebuggerBase, FpDebuggerResultData,
LazarusPackageIntf;
implementation implementation