mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-11-01 07:29:30 +01:00
Debugger: Configuration for value converter
This commit is contained in:
parent
2d0c2ea8ba
commit
6f99f0fe16
@ -0,0 +1,62 @@
|
||||
object JsonForDebugSettingsFrame: TJsonForDebugSettingsFrame
|
||||
Left = 0
|
||||
Height = 156
|
||||
Top = 0
|
||||
Width = 226
|
||||
AutoSize = True
|
||||
ChildSizing.TopBottomSpacing = 1
|
||||
ChildSizing.VerticalSpacing = 1
|
||||
ChildSizing.EnlargeHorizontal = crsScaleChilds
|
||||
ChildSizing.Layout = cclLeftToRightThenTopToBottom
|
||||
ChildSizing.ControlsPerLine = 2
|
||||
ClientHeight = 156
|
||||
ClientWidth = 226
|
||||
TabOrder = 0
|
||||
DesignLeft = 394
|
||||
DesignTop = 60
|
||||
object lblFuncName: TLabel
|
||||
Left = 0
|
||||
Height = 23
|
||||
Top = 1
|
||||
Width = 45
|
||||
Caption = '----'
|
||||
end
|
||||
object edFuncName: TEdit
|
||||
Left = 45
|
||||
Height = 23
|
||||
Top = 1
|
||||
Width = 181
|
||||
AutoSize = False
|
||||
TabOrder = 0
|
||||
end
|
||||
object lblJsonAddress: TLabel
|
||||
Left = 0
|
||||
Height = 23
|
||||
Top = 25
|
||||
Width = 45
|
||||
Caption = '----'
|
||||
end
|
||||
object edJsonAddress: TEdit
|
||||
Left = 45
|
||||
Height = 23
|
||||
Top = 25
|
||||
Width = 181
|
||||
AutoSize = False
|
||||
TabOrder = 1
|
||||
end
|
||||
object lblJsonTypename: TLabel
|
||||
Left = 0
|
||||
Height = 23
|
||||
Top = 49
|
||||
Width = 45
|
||||
Caption = '----'
|
||||
end
|
||||
object edJsonTypename: TEdit
|
||||
Left = 45
|
||||
Height = 23
|
||||
Top = 49
|
||||
Width = 181
|
||||
AutoSize = False
|
||||
TabOrder = 2
|
||||
end
|
||||
end
|
||||
@ -0,0 +1,328 @@
|
||||
unit FpDebugConvDebugForJson;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Forms, Controls, ExtCtrls, StdCtrls,
|
||||
FpDebugStringConstants, FpDebugValueConvertors, FpDebugDebuggerBase,
|
||||
LazDebuggerValueConverter, LazDebuggerIntfBaseTypes, FpDbgInfo, FpDbgClasses,
|
||||
FpdMemoryTools, FpDbgCallContextInfo, FpErrorMessages, DbgIntfBaseTypes;
|
||||
|
||||
type
|
||||
|
||||
{ TJsonForDebugSettingsFrame }
|
||||
|
||||
TJsonForDebugSettingsFrame = class(TFrame, TLazDbgValueConverterSettingsFrameIntf)
|
||||
edFuncName: TEdit;
|
||||
edJsonAddress: TEdit;
|
||||
edJsonTypename: TEdit;
|
||||
lblFuncName: TLabel;
|
||||
lblJsonAddress: TLabel;
|
||||
lblJsonTypename: TLabel;
|
||||
private
|
||||
|
||||
protected
|
||||
procedure ReadFrom(AConvertor: TLazDbgValueConverterIntf);
|
||||
function WriteTo(AConvertor: TLazDbgValueConverterIntf): Boolean;
|
||||
function GetFrame: TObject;
|
||||
public
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
end;
|
||||
|
||||
{ TFpDbgValueConverterJsonForDebug }
|
||||
|
||||
TFpDbgValueConverterJsonForDebug = class(TFpDbgValueConverter)
|
||||
private
|
||||
FFunctionName: String;
|
||||
FJsonAddressKey: String;
|
||||
FJsonTypenameKey: String;
|
||||
function FunctionNameIsStored: Boolean;
|
||||
function GetProcAddr(AnFpDebugger: TFpDebugDebuggerBase; AnExpressionScope: TFpDbgSymbolScope): TDBGPtr;
|
||||
function JsonAddressKeyIsStored: Boolean;
|
||||
protected
|
||||
function GetSettingsFrame: TLazDbgValueConverterSettingsFrameIntf; override;
|
||||
procedure Init; override;
|
||||
public
|
||||
class function GetName: String; override;
|
||||
class function GetSupportedKinds: TDbgSymbolKinds; override;
|
||||
procedure Assign(ASource: TFpDbgValueConverter); override;
|
||||
function ConvertValue(ASourceValue: TFpValue;
|
||||
AnFpDebugger: TFpDebugDebuggerBase;
|
||||
AnExpressionScope: TFpDbgSymbolScope
|
||||
): TFpValue; override;
|
||||
|
||||
published
|
||||
property FunctionName: String read FFunctionName write FFunctionName stored FunctionNameIsStored;
|
||||
property JsonAddressKey: String read FJsonAddressKey write FJsonAddressKey stored JsonAddressKeyIsStored;
|
||||
property JsonTypenameKey: String read FJsonTypenameKey write FJsonTypenameKey;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TJsonForDebugSettingsFrame }
|
||||
|
||||
procedure TJsonForDebugSettingsFrame.ReadFrom(
|
||||
AConvertor: TLazDbgValueConverterIntf);
|
||||
var
|
||||
c: TFpDbgValueConverterJsonForDebug;
|
||||
begin
|
||||
if not (AConvertor.GetObject is TFpDbgValueConverterJsonForDebug) then
|
||||
exit;
|
||||
|
||||
c := TFpDbgValueConverterJsonForDebug(AConvertor.GetObject);
|
||||
|
||||
edFuncName.Text := c.FFunctionName;
|
||||
edJsonAddress.Text := c.FJsonAddressKey;
|
||||
edJsonTypename.Text := c.FJsonTypenameKey;
|
||||
end;
|
||||
|
||||
function TJsonForDebugSettingsFrame.WriteTo(
|
||||
AConvertor: TLazDbgValueConverterIntf): Boolean;
|
||||
var
|
||||
c: TFpDbgValueConverterJsonForDebug;
|
||||
begin
|
||||
Result := False;
|
||||
if not (AConvertor.GetObject is TFpDbgValueConverterJsonForDebug) then
|
||||
exit;
|
||||
|
||||
c := TFpDbgValueConverterJsonForDebug(AConvertor.GetObject);
|
||||
|
||||
Result :=
|
||||
(c.FFunctionName <> trim(edFuncName.Text)) or
|
||||
(c.FJsonAddressKey <> trim(edJsonAddress.Text)) or
|
||||
(c.FJsonTypenameKey <> trim(edJsonTypename.Text));
|
||||
|
||||
c.FFunctionName := trim(edFuncName.Text);
|
||||
c.FJsonAddressKey := trim(edJsonAddress.Text);
|
||||
c.FJsonTypenameKey := trim(edJsonTypename.Text);
|
||||
end;
|
||||
|
||||
function TJsonForDebugSettingsFrame.GetFrame: TObject;
|
||||
begin
|
||||
Result := Self;
|
||||
end;
|
||||
|
||||
constructor TJsonForDebugSettingsFrame.Create(TheOwner: TComponent);
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
lblFuncName.Caption := drsFunctionName;
|
||||
lblJsonAddress.Caption := drsKeyForAddress;
|
||||
lblJsonTypename.Caption := drsKeyForTypename;
|
||||
end;
|
||||
|
||||
{ TFpDbgValueConverterJsonForDebug }
|
||||
|
||||
function TFpDbgValueConverterJsonForDebug.GetProcAddr(
|
||||
AnFpDebugger: TFpDebugDebuggerBase; AnExpressionScope: TFpDbgSymbolScope
|
||||
): TDBGPtr;
|
||||
var
|
||||
CurProc: TDbgProcess;
|
||||
ProcSymVal: TFpValue;
|
||||
ProcSym: TFpSymbol;
|
||||
begin
|
||||
Result := AnFpDebugger.GetCachedData(pointer(Self));
|
||||
if Result <> 0 then
|
||||
exit;
|
||||
|
||||
CurProc := AnFpDebugger.DbgController.CurrentProcess;
|
||||
if CurProc = nil then
|
||||
exit;
|
||||
|
||||
ProcSymVal := AnExpressionScope.FindSymbol(FFunctionName);
|
||||
if ProcSymVal <> nil then begin
|
||||
if (ProcSymVal.Kind = skProcedure) and IsTargetAddr(ProcSymVal.DataAddress)
|
||||
//and
|
||||
// (ProcSymVal.NestedSymbolCount = 3)
|
||||
then begin
|
||||
Result := ProcSymVal.DataAddress.Address;
|
||||
AnFpDebugger.SetCachedData(pointer(TFpDbgValueConverterJsonForDebug), Result);
|
||||
ProcSymVal.ReleaseReference;
|
||||
exit;
|
||||
end;
|
||||
Result := 0;
|
||||
Result := ProcSymVal.DataAddress.Address;
|
||||
end;
|
||||
|
||||
ProcSym := CurProc.FindProcSymbol(FFunctionName);
|
||||
if (ProcSym <> nil) and (ProcSym.Kind = skProcedure) and
|
||||
(IsTargetAddr(ProcSym.Address))
|
||||
then begin
|
||||
Result := ProcSym.Address.Address;
|
||||
AnFpDebugger.SetCachedData(pointer(TFpDbgValueConverterJsonForDebug), Result);
|
||||
end;
|
||||
ProcSym.ReleaseReference;
|
||||
end;
|
||||
|
||||
function TFpDbgValueConverterJsonForDebug.JsonAddressKeyIsStored: Boolean;
|
||||
begin
|
||||
Result := FJsonAddressKey <> 'Address';
|
||||
end;
|
||||
|
||||
function TFpDbgValueConverterJsonForDebug.FunctionNameIsStored: Boolean;
|
||||
begin
|
||||
Result := FFunctionName <> 'JsonForDebug';
|
||||
end;
|
||||
|
||||
function TFpDbgValueConverterJsonForDebug.GetSettingsFrame: TLazDbgValueConverterSettingsFrameIntf;
|
||||
begin
|
||||
Result := TJsonForDebugSettingsFrame.Create(nil);
|
||||
end;
|
||||
|
||||
procedure TFpDbgValueConverterJsonForDebug.Init;
|
||||
begin
|
||||
inherited Init;
|
||||
FFunctionName := 'JsonForDebug';
|
||||
FJsonAddressKey := 'Address'
|
||||
end;
|
||||
|
||||
class function TFpDbgValueConverterJsonForDebug.GetName: String;
|
||||
begin
|
||||
Result := drsCallJsonForDebug;
|
||||
end;
|
||||
|
||||
class function TFpDbgValueConverterJsonForDebug.GetSupportedKinds: TDbgSymbolKinds;
|
||||
begin
|
||||
Result := [low(Result)..high(Result)];
|
||||
end;
|
||||
|
||||
procedure TFpDbgValueConverterJsonForDebug.Assign(ASource: TFpDbgValueConverter);
|
||||
begin
|
||||
inherited Assign(ASource);
|
||||
if ASource is TFpDbgValueConverterJsonForDebug then begin
|
||||
FFunctionName := TFpDbgValueConverterJsonForDebug(ASource).FFunctionName;
|
||||
FJsonAddressKey := TFpDbgValueConverterJsonForDebug(ASource).FJsonAddressKey;
|
||||
FJsonTypenameKey := TFpDbgValueConverterJsonForDebug(ASource).FJsonTypenameKey;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFpDbgValueConverterJsonForDebug.ConvertValue(ASourceValue: TFpValue;
|
||||
AnFpDebugger: TFpDebugDebuggerBase; AnExpressionScope: TFpDbgSymbolScope
|
||||
): TFpValue;
|
||||
var
|
||||
CurProccess: TDbgProcess;
|
||||
TpName, JsonText: String;
|
||||
ProcAddr, SetLenProc, DecRefProc,
|
||||
TpNameAddr, TpNewNameAddr, TpNameRefAddr, TextAddr, TextRefAddr: TDbgPtr;
|
||||
CallContext: TFpDbgInfoCallContext;
|
||||
r: Boolean;
|
||||
begin
|
||||
Result := nil;
|
||||
|
||||
if (not (svfAddress in ASourceValue.FieldFlags)) or
|
||||
(not IsTargetAddr(ASourceValue.Address))
|
||||
then begin
|
||||
SetError(CreateError(fpErrAnyError, ['Value not in memory']));
|
||||
exit;
|
||||
end;
|
||||
|
||||
TpName := '';
|
||||
if ASourceValue.TypeInfo <> nil then
|
||||
TpName := ASourceValue.TypeInfo.Name;
|
||||
|
||||
if TpName = '' then begin
|
||||
SetError(CreateError(fpErrAnyError, ['no typename']));
|
||||
exit;
|
||||
end;
|
||||
|
||||
ProcAddr := GetProcAddr(AnFpDebugger, AnExpressionScope);
|
||||
if ProcAddr = 0 then begin
|
||||
SetError(CreateError(fpErrAnyError, ['JsonForDebug not found']));
|
||||
exit;
|
||||
end;
|
||||
|
||||
CurProccess := AnFpDebugger.DbgController.CurrentProcess;
|
||||
SetLenProc := AnFpDebugger.GetCached_FPC_ANSISTR_SETLENGTH;
|
||||
DecRefProc := AnFpDebugger.GetCached_FPC_ANSISTR_DECR_REF;
|
||||
if (SetLenProc = 0) or (DecRefProc = 0) or (CurProccess = nil)
|
||||
then begin
|
||||
SetError(CreateError(fpErrAnyError, ['internal error']));
|
||||
exit;
|
||||
end;
|
||||
|
||||
|
||||
TpNameAddr := 0;
|
||||
TpNewNameAddr := 0;
|
||||
TpNameRefAddr := 0;
|
||||
TextAddr := 0;
|
||||
TextRefAddr := 0;
|
||||
try
|
||||
if (not AnFpDebugger.CreateAnsiStringInTarget(SetLenProc, TpNameAddr, TpName, AnExpressionScope.LocationContext)) or
|
||||
(TpNameAddr = 0)
|
||||
then begin
|
||||
TpNameAddr := 0;
|
||||
SetError(CreateError(fpErrAnyError, ['failed to set param']));
|
||||
exit;
|
||||
end;
|
||||
|
||||
|
||||
CallContext := AnFpDebugger.DbgController.Call(TargetLoc(ProcAddr), AnExpressionScope.LocationContext,
|
||||
AnFpDebugger.MemReader, AnFpDebugger.MemConverter);
|
||||
|
||||
if (not CallContext.AddOrdinalParam(ASourceValue.Address.Address)) or
|
||||
(not CallContext.AddOrdinalViaRefAsParam(TpNameAddr, TpNameRefAddr)) or
|
||||
(not CallContext.AddOrdinalViaRefAsParam(0, TextRefAddr))
|
||||
then begin
|
||||
SetError(CreateError(fpErrAnyError, ['failed to set param']));
|
||||
exit;
|
||||
end;
|
||||
|
||||
CallContext.FinalizeParams; // force the string as first param (32bit) // TODO
|
||||
|
||||
AnFpDebugger.DbgController.ProcessLoop;
|
||||
|
||||
if not CallContext.IsValid then begin
|
||||
if (IsError(CallContext.LastError)) then
|
||||
SetError(CallContext.LastError)
|
||||
else
|
||||
if (CallContext.Message <> '') then
|
||||
SetError(CreateError(fpErrAnyError, [CallContext.Message]));
|
||||
exit;
|
||||
end;
|
||||
|
||||
r := True;
|
||||
if not CurProccess.ReadAddress(TpNameRefAddr, TpNewNameAddr) then begin
|
||||
r := False;
|
||||
TpNewNameAddr := 0;
|
||||
end;
|
||||
if not CurProccess.ReadAddress(TextRefAddr, TextAddr) then begin
|
||||
r := False;
|
||||
TextAddr:= 0;
|
||||
end;
|
||||
|
||||
if not AnFpDebugger.ReadAnsiStringFromTarget(TpNewNameAddr, TpName) then
|
||||
r := False;
|
||||
if not AnFpDebugger.ReadAnsiStringFromTarget(TextAddr, JsonText) then
|
||||
r := False;
|
||||
|
||||
if not r then begin
|
||||
SetError(CreateError(fpErrAnyError, ['failed to get result']));
|
||||
exit;
|
||||
end;
|
||||
|
||||
|
||||
AnFpDebugger.DbgController.AbortCurrentCommand;
|
||||
CallContext.ReleaseReference;
|
||||
|
||||
Result := TFpValueConstString.Create(JsonText);
|
||||
TFpValueConstString(Result).SetTypeName(TpName);
|
||||
|
||||
finally
|
||||
if TpNewNameAddr <> 0 then
|
||||
TpNameAddr := TpNewNameAddr;
|
||||
if TpNameAddr <> 0 then
|
||||
AnFpDebugger.CallTargetFuncStringDecRef(DecRefProc, TpNameAddr, AnExpressionScope.LocationContext);
|
||||
if TextAddr <> 0 then
|
||||
AnFpDebugger.CallTargetFuncStringDecRef(DecRefProc, TextAddr, AnExpressionScope.LocationContext);
|
||||
end;
|
||||
end;
|
||||
|
||||
initialization
|
||||
ValueConverterClassList.Add(TFpDbgValueConverterJsonForDebug);
|
||||
|
||||
end.
|
||||
|
||||
@ -41,7 +41,9 @@ uses
|
||||
{$IFDEF FPDEBUG_THREAD_CHECK} FpDbgCommon, {$ENDIF}
|
||||
FpDbgClasses, FpDbgInfo, FpErrorMessages, FpPascalBuilder, FpdMemoryTools,
|
||||
FpPascalParser, FPDbgController, FpDbgDwarfDataClasses, FpDbgDwarfFreePascal,
|
||||
FpDbgDwarf, FpDbgUtil;
|
||||
FpDbgDwarf, FpDbgUtil,
|
||||
// use converters
|
||||
FpDebugValueConvertors, FpDebugConvDebugForJson;
|
||||
|
||||
type
|
||||
|
||||
|
||||
@ -0,0 +1,21 @@
|
||||
unit FpDebugStringConstants;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils;
|
||||
|
||||
resourcestring
|
||||
drsKeyForAddress = 'Key for Address';
|
||||
drsKeyForTypename = 'Key for Typename';
|
||||
|
||||
drsFunctionName = 'Function name';
|
||||
drsCallSysVarToLStr = 'Call SysVarToLStr';
|
||||
drsCallJsonForDebug = 'Call JsonForDebug';
|
||||
|
||||
implementation
|
||||
|
||||
end.
|
||||
|
||||
@ -6,9 +6,9 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, fgl, FpDbgInfo, FpdMemoryTools, FpDbgCallContextInfo,
|
||||
FpPascalBuilder, FpErrorMessages, FpDbgClasses, FpDbgUtil,
|
||||
DbgIntfBaseTypes, lazCollections, LazClasses, LCLProc, StrUtils,
|
||||
FpDebugDebuggerBase, LazDebuggerValueConverter, LazDebuggerIntfBaseTypes;
|
||||
FpPascalBuilder, FpErrorMessages, FpDbgClasses, FpDbgUtil, DbgIntfBaseTypes,
|
||||
lazCollections, LazClasses, LCLProc, StrUtils, FpDebugDebuggerBase, FpDebugStringConstants,
|
||||
LazDebuggerValueConverter, LazDebuggerIntfBaseTypes;
|
||||
|
||||
type
|
||||
TDbgSymbolKinds = set of TDbgSymbolKind;
|
||||
@ -25,10 +25,13 @@ type
|
||||
FLastErrror: TFpError;
|
||||
protected
|
||||
function GetObject: TObject;
|
||||
function GetSettingsFrame: TLazDbgValueConverterSettingsFrameIntf; virtual;
|
||||
procedure Init; virtual;
|
||||
public
|
||||
class function GetName: String; virtual; abstract;
|
||||
class function GetSupportedKinds: TDbgSymbolKinds; virtual;
|
||||
procedure Assign(ASource: TFpDbgValueConverter);
|
||||
constructor Create; virtual;
|
||||
procedure Assign(ASource: TFpDbgValueConverter); virtual;
|
||||
function CreateCopy: TFpDbgValueConverter; virtual;
|
||||
function ConvertValue(ASourceValue: TFpValue;
|
||||
AnFpDebugger: TFpDebugDebuggerBase;
|
||||
@ -55,7 +58,8 @@ type
|
||||
FMatchTypeNames: TStrings;
|
||||
procedure SetConverter(AValue: TFpDbgValueConverter);
|
||||
protected
|
||||
function GetBackendSpecificObject: TObject;
|
||||
function GetBackendSpecificObject: TObject; deprecated;
|
||||
function GetConverter: TLazDbgValueConverterIntf;
|
||||
public
|
||||
constructor Create(AConverter: TFpDbgValueConverter);
|
||||
destructor Destroy; override;
|
||||
@ -98,21 +102,6 @@ type
|
||||
): TFpValue; override;
|
||||
end;
|
||||
|
||||
{ TFpDbgValueConverterJsonForDebug }
|
||||
|
||||
TFpDbgValueConverterJsonForDebug = class(TFpDbgValueConverter)
|
||||
private
|
||||
function GetProcAddr(AnFpDebugger: TFpDebugDebuggerBase; AnExpressionScope: TFpDbgSymbolScope): TDBGPtr;
|
||||
public
|
||||
class function GetName: String; override;
|
||||
class function GetSupportedKinds: TDbgSymbolKinds; override;
|
||||
function ConvertValue(ASourceValue: TFpValue;
|
||||
AnFpDebugger: TFpDebugDebuggerBase;
|
||||
AnExpressionScope: TFpDbgSymbolScope
|
||||
): TFpValue; override;
|
||||
end;
|
||||
|
||||
|
||||
function ValueConverterClassList: TFpDbgValueConverterClassList;
|
||||
function ValueConverterConfigList: TFpDbgConverterConfigList;
|
||||
|
||||
@ -167,11 +156,27 @@ begin
|
||||
Result := Self;
|
||||
end;
|
||||
|
||||
function TFpDbgValueConverter.GetSettingsFrame: TLazDbgValueConverterSettingsFrameIntf;
|
||||
begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
procedure TFpDbgValueConverter.Init;
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
class function TFpDbgValueConverter.GetSupportedKinds: TDbgSymbolKinds;
|
||||
begin
|
||||
Result := [low(TDbgSymbolKinds)..high(TDbgSymbolKinds)];
|
||||
end;
|
||||
|
||||
constructor TFpDbgValueConverter.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
Init;
|
||||
end;
|
||||
|
||||
procedure TFpDbgValueConverter.Assign(ASource: TFpDbgValueConverter);
|
||||
begin
|
||||
//
|
||||
@ -193,6 +198,11 @@ begin
|
||||
Result := Self;
|
||||
end;
|
||||
|
||||
function TFpDbgConverterConfig.GetConverter: TLazDbgValueConverterIntf;
|
||||
begin
|
||||
Result := FConverter;
|
||||
end;
|
||||
|
||||
function TFpDbgConverterConfig.CreateCopy: TFpDbgConverterConfig;
|
||||
begin
|
||||
Result := TFpDbgConverterConfigClass(ClassType).Create(nil);
|
||||
@ -223,9 +233,6 @@ begin
|
||||
end;
|
||||
|
||||
function TFpDbgConverterConfig.CheckMatch(AValue: TFpValue): Boolean;
|
||||
var
|
||||
t: TFpSymbol;
|
||||
TpName: String;
|
||||
begin
|
||||
Result := (AValue.Kind in (FMatchKinds * Converter.GetSupportedKinds)) and
|
||||
CheckTypeMatch(AValue);
|
||||
@ -412,7 +419,7 @@ end;
|
||||
|
||||
class function TFpDbgValueConverterVariantToLStr.GetName: String;
|
||||
begin
|
||||
Result := 'Call SysVarToLStr';
|
||||
Result := drsCallSysVarToLStr;
|
||||
end;
|
||||
|
||||
class function TFpDbgValueConverterVariantToLStr.GetSupportedKinds: TDbgSymbolKinds;
|
||||
@ -540,181 +547,8 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TFpDbgValueConverterJsonForDebug }
|
||||
|
||||
function TFpDbgValueConverterJsonForDebug.GetProcAddr(
|
||||
AnFpDebugger: TFpDebugDebuggerBase; AnExpressionScope: TFpDbgSymbolScope
|
||||
): TDBGPtr;
|
||||
var
|
||||
CurProc: TDbgProcess;
|
||||
ProcSymVal: TFpValue;
|
||||
ProcSym: TFpSymbol;
|
||||
begin
|
||||
Result := AnFpDebugger.GetCachedData(pointer(TFpDbgValueConverterJsonForDebug));
|
||||
if Result <> 0 then
|
||||
exit;
|
||||
|
||||
CurProc := AnFpDebugger.DbgController.CurrentProcess;
|
||||
if CurProc = nil then
|
||||
exit;
|
||||
|
||||
ProcSymVal := AnExpressionScope.FindSymbol('JsonForDebug');
|
||||
if ProcSymVal <> nil then begin
|
||||
if (ProcSymVal.Kind = skProcedure) and IsTargetAddr(ProcSymVal.DataAddress) then begin
|
||||
Result := ProcSymVal.DataAddress.Address;
|
||||
AnFpDebugger.SetCachedData(pointer(TFpDbgValueConverterJsonForDebug), Result);
|
||||
ProcSymVal.ReleaseReference;
|
||||
exit;
|
||||
end;
|
||||
Result := 0;
|
||||
Result := ProcSymVal.DataAddress.Address;
|
||||
end;
|
||||
|
||||
ProcSym := CurProc.FindProcSymbol('JsonForDebug');
|
||||
if (ProcSym <> nil) and (ProcSym.Kind = skProcedure) and
|
||||
(IsTargetAddr(ProcSym.Address))
|
||||
then begin
|
||||
Result := ProcSym.Address.Address;
|
||||
AnFpDebugger.SetCachedData(pointer(TFpDbgValueConverterJsonForDebug), Result);
|
||||
end;
|
||||
ProcSym.ReleaseReference;
|
||||
end;
|
||||
|
||||
class function TFpDbgValueConverterJsonForDebug.GetName: String;
|
||||
begin
|
||||
Result := 'Call JsonForDebug';
|
||||
end;
|
||||
|
||||
class function TFpDbgValueConverterJsonForDebug.GetSupportedKinds: TDbgSymbolKinds;
|
||||
begin
|
||||
Result := [low(Result)..high(Result)];
|
||||
end;
|
||||
|
||||
function TFpDbgValueConverterJsonForDebug.ConvertValue(ASourceValue: TFpValue;
|
||||
AnFpDebugger: TFpDebugDebuggerBase; AnExpressionScope: TFpDbgSymbolScope
|
||||
): TFpValue;
|
||||
var
|
||||
CurProccess: TDbgProcess;
|
||||
TpName, JsonText: String;
|
||||
ProcAddr, SetLenProc, DecRefProc,
|
||||
TpNameAddr, TpNewNameAddr, TpNameRefAddr, TextAddr, TextRefAddr: TDbgPtr;
|
||||
CallContext: TFpDbgInfoCallContext;
|
||||
r: Boolean;
|
||||
AddrSize: Integer;
|
||||
begin
|
||||
Result := nil;
|
||||
|
||||
if (not (svfAddress in ASourceValue.FieldFlags)) or
|
||||
(not IsTargetAddr(ASourceValue.Address))
|
||||
then begin
|
||||
SetError(CreateError(fpErrAnyError, ['Value not in memory']));
|
||||
exit;
|
||||
end;
|
||||
|
||||
TpName := '';
|
||||
if ASourceValue.TypeInfo <> nil then
|
||||
TpName := ASourceValue.TypeInfo.Name;
|
||||
|
||||
if TpName = '' then begin
|
||||
SetError(CreateError(fpErrAnyError, ['no typename']));
|
||||
exit;
|
||||
end;
|
||||
|
||||
ProcAddr := GetProcAddr(AnFpDebugger, AnExpressionScope);
|
||||
if ProcAddr = 0 then begin
|
||||
SetError(CreateError(fpErrAnyError, ['JsonForDebug not found']));
|
||||
exit;
|
||||
end;
|
||||
|
||||
CurProccess := AnFpDebugger.DbgController.CurrentProcess;
|
||||
SetLenProc := AnFpDebugger.GetCached_FPC_ANSISTR_SETLENGTH;
|
||||
DecRefProc := AnFpDebugger.GetCached_FPC_ANSISTR_DECR_REF;
|
||||
if (SetLenProc = 0) or (DecRefProc = 0) or (CurProccess = nil)
|
||||
then begin
|
||||
SetError(CreateError(fpErrAnyError, ['internal error']));
|
||||
exit;
|
||||
end;
|
||||
|
||||
|
||||
TpNameAddr := 0;
|
||||
TpNewNameAddr := 0;
|
||||
TpNameRefAddr := 0;
|
||||
TextAddr := 0;
|
||||
TextRefAddr := 0;
|
||||
try
|
||||
if (not AnFpDebugger.CreateAnsiStringInTarget(SetLenProc, TpNameAddr, TpName, AnExpressionScope.LocationContext)) or
|
||||
(TpNameAddr = 0)
|
||||
then begin
|
||||
TpNameAddr := 0;
|
||||
SetError(CreateError(fpErrAnyError, ['failed to set param']));
|
||||
exit;
|
||||
end;
|
||||
|
||||
|
||||
CallContext := AnFpDebugger.DbgController.Call(TargetLoc(ProcAddr), AnExpressionScope.LocationContext,
|
||||
AnFpDebugger.MemReader, AnFpDebugger.MemConverter);
|
||||
|
||||
if (not CallContext.AddOrdinalParam(ASourceValue.Address.Address)) or
|
||||
(not CallContext.AddOrdinalViaRefAsParam(TpNameAddr, TpNameRefAddr)) or
|
||||
(not CallContext.AddOrdinalViaRefAsParam(0, TextRefAddr))
|
||||
then begin
|
||||
SetError(CreateError(fpErrAnyError, ['failed to set param']));
|
||||
exit;
|
||||
end;
|
||||
|
||||
CallContext.FinalizeParams; // force the string as first param (32bit) // TODO
|
||||
|
||||
AnFpDebugger.DbgController.ProcessLoop;
|
||||
|
||||
if not CallContext.IsValid then begin
|
||||
if (IsError(CallContext.LastError)) then
|
||||
SetError(CallContext.LastError)
|
||||
else
|
||||
if (CallContext.Message <> '') then
|
||||
SetError(CreateError(fpErrAnyError, [CallContext.Message]));
|
||||
exit;
|
||||
end;
|
||||
|
||||
r := True;
|
||||
if not CurProccess.ReadAddress(TpNameRefAddr, TpNewNameAddr) then begin
|
||||
r := False;
|
||||
TpNewNameAddr := 0;
|
||||
end;
|
||||
if not CurProccess.ReadAddress(TextRefAddr, TextAddr) then begin
|
||||
r := False;
|
||||
TextAddr:= 0;
|
||||
end;
|
||||
|
||||
if not AnFpDebugger.ReadAnsiStringFromTarget(TpNewNameAddr, TpName) then
|
||||
r := False;
|
||||
if not AnFpDebugger.ReadAnsiStringFromTarget(TextAddr, JsonText) then
|
||||
r := False;
|
||||
|
||||
if not r then begin
|
||||
SetError(CreateError(fpErrAnyError, ['failed to get result']));
|
||||
exit;
|
||||
end;
|
||||
|
||||
|
||||
AnFpDebugger.DbgController.AbortCurrentCommand;
|
||||
CallContext.ReleaseReference;
|
||||
|
||||
Result := TFpValueConstString.Create(JsonText);
|
||||
TFpValueConstString(Result).SetTypeName(TpName);
|
||||
|
||||
finally
|
||||
if TpNewNameAddr <> 0 then
|
||||
TpNameAddr := TpNewNameAddr;
|
||||
if TpNameAddr <> 0 then
|
||||
AnFpDebugger.CallTargetFuncStringDecRef(DecRefProc, TpNameAddr, AnExpressionScope.LocationContext);
|
||||
if TextAddr <> 0 then
|
||||
AnFpDebugger.CallTargetFuncStringDecRef(DecRefProc, TextAddr, AnExpressionScope.LocationContext);
|
||||
end;
|
||||
end;
|
||||
|
||||
initialization
|
||||
ValueConverterClassList.Add(TFpDbgValueConverterVariantToLStr);
|
||||
ValueConverterClassList.Add(TFpDbgValueConverterJsonForDebug);
|
||||
|
||||
finalization;
|
||||
FreeAndNil(TheValueConverterClassList);
|
||||
|
||||
@ -48,6 +48,14 @@
|
||||
<Filename Value="fpdebuggerresultdata.pas"/>
|
||||
<UnitName Value="FpDebuggerResultData"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Filename Value="fpdebugconvdebugforjson.pas"/>
|
||||
<UnitName Value="FpDebugConvDebugForJson"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Filename Value="fpdebugstringconstants.pas"/>
|
||||
<UnitName Value="FpDebugStringConstants"/>
|
||||
</Item>
|
||||
</Files>
|
||||
<RequiredPkgs>
|
||||
<Item>
|
||||
|
||||
@ -10,7 +10,7 @@ interface
|
||||
uses
|
||||
FpDebugDebugger, FpDebugDebuggerUtils, FpDebugDebuggerWorkThreads,
|
||||
FpDebugValueConvertors, FpDebugDebuggerBase, FpDebuggerResultData,
|
||||
LazarusPackageIntf;
|
||||
FpDebugConvDebugForJson, FpDebugStringConstants, LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
@ -9,17 +9,28 @@ uses
|
||||
Classes, SysUtils;
|
||||
|
||||
type
|
||||
TLazDbgValueConverterIntf = interface;
|
||||
|
||||
TLazDbgValueConverterSettingsFrameIntf = interface
|
||||
procedure ReadFrom(AConvertor: TLazDbgValueConverterIntf);
|
||||
function WriteTo(AConvertor: TLazDbgValueConverterIntf): Boolean;
|
||||
|
||||
function GetFrame: TObject; // TFrame
|
||||
procedure Free;
|
||||
end;
|
||||
|
||||
TLazDbgValueConverterIntf = interface
|
||||
procedure AddReference;
|
||||
procedure ReleaseReference;
|
||||
function GetObject: TObject;
|
||||
function GetSettingsFrame: TLazDbgValueConverterSettingsFrameIntf;
|
||||
end;
|
||||
|
||||
TLazDbgValueConvertSelectorIntf = interface
|
||||
procedure AddFreeNotification(ANotification: TNotifyEvent);
|
||||
procedure RemoveFreeNotification(ANotification: TNotifyEvent);
|
||||
function GetBackendSpecificObject: TObject;
|
||||
function GetConverter: TLazDbgValueConverterIntf;
|
||||
function GetBackendSpecificObject: TObject; deprecated;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
@ -6,7 +6,8 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, DbgIntfDebuggerBase, IdeDebuggerBase, Debugger,
|
||||
IdeDebuggerWatchResult, LazDebuggerIntf, LazDebuggerIntfBaseTypes;
|
||||
IdeDebuggerWatchResult, LazDebuggerIntf, LazDebuggerIntfBaseTypes,
|
||||
LazDebuggerValueConverter;
|
||||
|
||||
type
|
||||
|
||||
@ -90,7 +91,7 @@ type
|
||||
procedure RemoveNotification(AnEventType: TWatcheEvaluateEvent;
|
||||
AnEvent: TNotifyEvent);
|
||||
function ResData: TLzDbgWatchDataIntf;
|
||||
function GetFpDbgConverter: TObject;
|
||||
function GetFpDbgConverter: TLazDbgValueConvertSelectorIntf;
|
||||
protected
|
||||
procedure RequestData;
|
||||
function GetTypeInfo: TDBGType; override;
|
||||
@ -428,7 +429,7 @@ begin
|
||||
Result := FCurrentResData;
|
||||
end;
|
||||
|
||||
function TTestWatchValue.GetFpDbgConverter: TObject;
|
||||
function TTestWatchValue.GetFpDbgConverter: TLazDbgValueConvertSelectorIntf;
|
||||
begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
@ -8,7 +8,8 @@ uses
|
||||
Classes, SysUtils, LazClasses, LazLoggerBase, IdeDebuggerWatchResult,
|
||||
IdeDebuggerFpDbgValueConv, IdeDebuggerWatchResultJSon, DbgIntfDebuggerBase,
|
||||
DbgIntfMiscClasses, LazDebuggerIntf, LazDebuggerTemplate,
|
||||
LazDebuggerIntfBaseTypes, FpDebugValueConvertors;
|
||||
LazDebuggerIntfBaseTypes, LazDebuggerValueConverter, FpDebugValueConvertors,
|
||||
FpDebugConvDebugForJson;
|
||||
|
||||
type
|
||||
|
||||
@ -245,36 +246,55 @@ function TWatchValue.GetResultData: TWatchResultData;
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
var
|
||||
UsedConv: TLazDbgValueConverterIntf;
|
||||
SrcData: TWatchResultData;
|
||||
|
||||
function CreateJson: TWatchResultDataJSon;
|
||||
begin
|
||||
Result := TWatchResultDataJSon.Create(SrcData.AsString);
|
||||
Result.SetTypeName(SrcData.TypeName);
|
||||
if SrcData.HasDataAddress then
|
||||
Result.SetDataAddress(SrcData.DataAddress);
|
||||
if (Result.Count > 0) or (Result.FieldCount > 0) then
|
||||
FResultDataContent := rdcJSon;
|
||||
if (UsedConv <> nil) and (UsedConv.GetObject is TFpDbgValueConverterJsonForDebug)
|
||||
then begin
|
||||
Result.JsonAddressKey := TFpDbgValueConverterJsonForDebug(UsedConv.GetObject).JsonAddressKey;
|
||||
Result.JsonTypenameKey := TFpDbgValueConverterJsonForDebug(UsedConv.GetObject).JsonTypenameKey;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
Result := FResultData;
|
||||
|
||||
if (FResultDataContent = rdcNotSpecial) or (Result = nil) then
|
||||
exit;
|
||||
|
||||
if FResultDataSpecialised <> nil then begin
|
||||
Result := FResultDataSpecialised;
|
||||
exit;
|
||||
end;
|
||||
|
||||
if (Result.ValueKind = rdkConvertRes) and (Result.FieldCount > 0) and
|
||||
(Result.Fields[0].Field.ValueKind <> rdkError)
|
||||
then
|
||||
Result := Result.Fields[0].Field;
|
||||
Result := FResultData;
|
||||
if (FResultDataContent = rdcNotSpecial) or (Result = nil) then
|
||||
exit;
|
||||
|
||||
SrcData := FResultData;
|
||||
UsedConv := nil;
|
||||
if (SrcData.ValueKind = rdkConvertRes) and (SrcData.FieldCount > 0) and
|
||||
(SrcData.Fields[0].Field <> nil) and
|
||||
(SrcData.Fields[0].Field.ValueKind <> rdkError)
|
||||
then begin
|
||||
SrcData := SrcData.Fields[0].Field;
|
||||
UsedConv := FResultData.BackendValueHandler;
|
||||
end;
|
||||
|
||||
case FResultDataContent of
|
||||
rdcJSon:
|
||||
FResultDataSpecialised := TWatchResultDataJSon.Create(Result.AsString);
|
||||
rdcJSon: begin
|
||||
FResultDataSpecialised := CreateJson;
|
||||
end;
|
||||
|
||||
else begin
|
||||
FResultDataContent := rdcNotSpecial;
|
||||
|
||||
if (Result.ValueKind in [rdkString, rdkPrePrinted]) and (IsMaybeJson(Result.AsString)) then begin
|
||||
FResultDataSpecialised := TWatchResultDataJSon.Create(Result.AsString);
|
||||
TWatchResultDataJSon(FResultDataSpecialised).SetTypeName(FResultData.TypeName);
|
||||
if FResultData.HasDataAddress then
|
||||
TWatchResultDataJSon(FResultDataSpecialised).SetDataAddress(FResultData.DataAddress);
|
||||
if (FResultDataSpecialised.Count > 0) or (FResultDataSpecialised.FieldCount > 0) then
|
||||
FResultDataContent := rdcJSon;
|
||||
if (SrcData.ValueKind in [rdkString, rdkPrePrinted]) and (IsMaybeJson(SrcData.AsString)) then begin
|
||||
FResultDataSpecialised := CreateJson;
|
||||
end;
|
||||
|
||||
if FResultDataContent = rdcNotSpecial then
|
||||
|
||||
@ -698,7 +698,7 @@ type
|
||||
// FDataFlags: TWatchResultDataFlags;
|
||||
// Addr: TDbgPtr;
|
||||
// MemDump
|
||||
function GetBackendValueHandler: TLazDbgValueConverterIntf;
|
||||
function GetBackendValueHandler: TLazDbgValueConverterIntf; virtual;
|
||||
function GetClassID: TWatchResultDataClassID; virtual; //abstract;
|
||||
protected
|
||||
class function GetStorageClass: TWatchResultStorageClass; virtual; abstract;
|
||||
@ -721,6 +721,7 @@ type
|
||||
procedure ClearData; virtual; abstract;
|
||||
protected
|
||||
function GetValueKind: TWatchResultDataKind; virtual; //abstract;
|
||||
function GetTypeName: String; virtual;
|
||||
function GetAsString: String; virtual; abstract;
|
||||
function GetAsDesc: String; virtual; abstract;
|
||||
function GetAsWideString: WideString; virtual; abstract;
|
||||
@ -776,7 +777,7 @@ type
|
||||
function GetEnumerator: TWatchResultDataEnumerator; virtual;
|
||||
public
|
||||
property ValueKind: TWatchResultDataKind read GetValueKind;
|
||||
property TypeName: String read FTypeName;
|
||||
property TypeName: String read GetTypeName;
|
||||
|
||||
property AsString: String read GetAsString;
|
||||
property AsDesc: String read GetAsDesc;
|
||||
@ -1048,6 +1049,7 @@ type
|
||||
protected
|
||||
function GetHasDataAddress: Boolean; override;
|
||||
function GetDataAddress: TDBGPtr; override;
|
||||
procedure SetDataAddress(AnAddr: TDbgPtr); override;
|
||||
public
|
||||
constructor Create(AStringVal: String);
|
||||
end;
|
||||
@ -1444,7 +1446,7 @@ type
|
||||
private
|
||||
function GetClassID: TWatchResultDataClassID; override;
|
||||
protected
|
||||
function GetBackendValueHandler: TLazDbgValueConverterIntf;
|
||||
function GetBackendValueHandler: TLazDbgValueConverterIntf; override;
|
||||
public
|
||||
constructor Create(AHandler: TLazDbgValueConverterIntf);
|
||||
end;
|
||||
@ -2582,6 +2584,11 @@ begin
|
||||
Result := wdPrePrint;
|
||||
end;
|
||||
|
||||
function TWatchResultData.GetTypeName: String;
|
||||
begin
|
||||
Result := FTypeName;
|
||||
end;
|
||||
|
||||
function TWatchResultData.GetBackendValueHandler: TLazDbgValueConverterIntf;
|
||||
begin
|
||||
Result := nil;
|
||||
@ -3462,6 +3469,11 @@ begin
|
||||
Result := FData.GetDataAddress;
|
||||
end;
|
||||
|
||||
procedure TWatchResultDataString.SetDataAddress(AnAddr: TDbgPtr);
|
||||
begin
|
||||
FData.FAddress := AnAddr;
|
||||
end;
|
||||
|
||||
constructor TWatchResultDataString.Create(AStringVal: String);
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
@ -17,12 +17,15 @@ type
|
||||
FInternalJSon: TJSONData;
|
||||
FIndex: Integer;
|
||||
FCurData: TWatchResultDataJSonBase;
|
||||
FJsonAddressKey: String;
|
||||
FJsonTypenameKey: String;
|
||||
|
||||
function JSon: TJSONData; inline;
|
||||
protected
|
||||
function GetAsString: String; override;
|
||||
function GetDataAddress: TDBGPtr; override;
|
||||
function GetHasDataAddress: Boolean; override;
|
||||
function GetTypeName: String; override;
|
||||
|
||||
// arary
|
||||
function GetCount: Integer; override;
|
||||
@ -39,6 +42,9 @@ type
|
||||
procedure SetSelectedIndex(AnIndex: Integer); override;
|
||||
|
||||
function HandleExpressionSuffix(ASuffix: String): TWatchResultData; override;
|
||||
|
||||
property JsonAddressKey: String read FJsonAddressKey write FJsonAddressKey;
|
||||
property JsonTypenameKey: String read FJsonTypenameKey write FJsonTypenameKey;
|
||||
end;
|
||||
|
||||
{ TWatchResultDataJSon }
|
||||
@ -92,18 +98,28 @@ function TWatchResultDataJSonBase.GetDataAddress: TDBGPtr;
|
||||
var
|
||||
j: TJSONData;
|
||||
begin
|
||||
Result := 0;
|
||||
j := JSon;
|
||||
if (j = nil) and not(j is TJSONObject) then
|
||||
exit;
|
||||
if (FJsonAddressKey = '') or (j = nil) or not(j is TJSONObject)
|
||||
then
|
||||
exit(inherited GetDataAddress);
|
||||
|
||||
if (TJSONObject(j).Elements['Address'] <> nil) then
|
||||
j := TJSONObject(j).Elements['Address']
|
||||
else
|
||||
j := TJSONObject(j).Elements['DataAddress'];
|
||||
try
|
||||
j := TJSONObject(j).Elements[FJsonAddressKey];
|
||||
except
|
||||
j := nil;
|
||||
end;
|
||||
|
||||
if j = nil then
|
||||
exit(inherited GetDataAddress);
|
||||
|
||||
if j is TJSONString then begin
|
||||
if not TryStrToQWord(j.AsString, Result) then
|
||||
Result := inherited GetDataAddress;
|
||||
exit;
|
||||
end;
|
||||
|
||||
if ((j is TJSONFloatNumber)) or not(j is TJSONNumber) then
|
||||
exit;
|
||||
exit(inherited GetDataAddress);
|
||||
|
||||
if j is TJSONInt64Number then
|
||||
Result := TDBGPtr(j.AsInt64)
|
||||
@ -114,18 +130,48 @@ end;
|
||||
function TWatchResultDataJSonBase.GetHasDataAddress: Boolean;
|
||||
var
|
||||
j: TJSONData;
|
||||
d: QWord;
|
||||
begin
|
||||
Result := inherited GetHasDataAddress;
|
||||
if Result then
|
||||
exit;
|
||||
|
||||
j := JSon;
|
||||
Result := (j <> nil) and (j is TJSONObject);
|
||||
Result := (FJsonAddressKey <> '') and (j <> nil) and (j is TJSONObject);
|
||||
if not Result then
|
||||
exit;
|
||||
|
||||
if (TJSONObject(j).Elements['Address'] <> nil) then
|
||||
j := TJSONObject(j).Elements['Address']
|
||||
else
|
||||
j := TJSONObject(j).Elements['DataAddress'];
|
||||
try
|
||||
j := TJSONObject(j).Elements[FJsonAddressKey];
|
||||
except
|
||||
j := nil;
|
||||
end;
|
||||
if j = nil then
|
||||
exit(False);
|
||||
|
||||
Result := (j is TJSONNumber) and not (j is TJSONFloatNumber);
|
||||
Result := ((j is TJSONNumber) and not (j is TJSONFloatNumber)) or
|
||||
((j is TJSONString) and (TryStrToQWord(j.AsString, d)));
|
||||
end;
|
||||
|
||||
function TWatchResultDataJSonBase.GetTypeName: String;
|
||||
var
|
||||
j: TJSONData;
|
||||
begin
|
||||
Result := '';
|
||||
j := JSon;
|
||||
if (FJsonTypenameKey = '') or (j = nil) or not(j is TJSONObject) then
|
||||
exit(inherited GetTypeName);
|
||||
|
||||
try
|
||||
j := TJSONObject(j).Elements[FJsonTypenameKey];
|
||||
except
|
||||
j := nil;
|
||||
end;
|
||||
|
||||
if (j = nil) or not(j is TJSONString) then
|
||||
exit(inherited GetTypeName);
|
||||
|
||||
Result := j.AsString;
|
||||
end;
|
||||
|
||||
function TWatchResultDataJSonBase.GetCount: Integer;
|
||||
@ -159,6 +205,10 @@ begin
|
||||
FCurData := TWatchResultDataJSonBase.Create('');
|
||||
if JSon <> nil then
|
||||
FCurData.FInternalJSon := JSon.Items[FIndex];
|
||||
|
||||
TWatchResultDataJSon(FCurData).FJsonAddressKey := FJsonAddressKey;
|
||||
TWatchResultDataJSon(FCurData).FJsonTypenameKey := FJsonTypenameKey;
|
||||
|
||||
Result := FCurData;
|
||||
end;
|
||||
|
||||
@ -187,6 +237,10 @@ begin
|
||||
FCurData.FInternalJSon := JSon.Items[AnIndex];
|
||||
Result.FieldName := TJSONObject(JSon).Names[AnIndex];
|
||||
end;
|
||||
|
||||
TWatchResultDataJSon(FCurData).FJsonAddressKey := FJsonAddressKey;
|
||||
TWatchResultDataJSon(FCurData).FJsonTypenameKey := FJsonTypenameKey;
|
||||
|
||||
Result.Field := FCurData;
|
||||
Result.Owner := Self;
|
||||
end;
|
||||
@ -316,6 +370,8 @@ begin
|
||||
|
||||
if (Idx > SfxLen) and (js <> nil) and (js <> JSon) then begin
|
||||
Result := TWatchResultDataJSon.Create(js.AsJSON);
|
||||
TWatchResultDataJSon(Result).FJsonAddressKey := FJsonAddressKey;
|
||||
TWatchResultDataJSon(Result).FJsonTypenameKey := FJsonTypenameKey;
|
||||
exit;
|
||||
end;
|
||||
|
||||
|
||||
@ -17,6 +17,7 @@ object FpDbgValConvFrame: TFpDbgValConvFrame
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 150
|
||||
ClientWidth = 512
|
||||
Constraints.MinHeight = 80
|
||||
TabOrder = 0
|
||||
object lstConverters: TCheckListBox
|
||||
Left = 5
|
||||
@ -79,6 +80,7 @@ object FpDbgValConvFrame: TFpDbgValConvFrame
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 362
|
||||
ClientWidth = 512
|
||||
Constraints.MinHeight = 120
|
||||
TabOrder = 2
|
||||
object Panel4: TPanel
|
||||
Left = 342
|
||||
@ -111,6 +113,7 @@ object FpDbgValConvFrame: TFpDbgValConvFrame
|
||||
Top = 25
|
||||
Width = 160
|
||||
ItemHeight = 15
|
||||
OnChange = dropActionChange
|
||||
Style = csDropDownList
|
||||
TabOrder = 0
|
||||
end
|
||||
@ -181,6 +184,17 @@ object FpDbgValConvFrame: TFpDbgValConvFrame
|
||||
Top = 150
|
||||
Width = 512
|
||||
Align = alTop
|
||||
OnCanOffset = Splitter1CanOffset
|
||||
ResizeAnchor = akTop
|
||||
end
|
||||
object pnlCurConvSetting: TPanel
|
||||
Left = 0
|
||||
Height = 0
|
||||
Top = 519
|
||||
Width = 512
|
||||
Align = alBottom
|
||||
AutoSize = True
|
||||
Caption = 'PnlConvSetting'
|
||||
TabOrder = 3
|
||||
end
|
||||
end
|
||||
|
||||
@ -6,8 +6,8 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Forms, Controls, ExtCtrls, StdCtrls, CheckLst, LCLIntf,
|
||||
Dialogs, StrUtils, FpDebugValueConvertors, IdeDebuggerStringConstants,
|
||||
IdeDebuggerFpDbgValueConv;
|
||||
Dialogs, StrUtils, FpDebugValueConvertors, LazDebuggerValueConverter,
|
||||
IdeDebuggerStringConstants, IdeDebuggerFpDbgValueConv;
|
||||
|
||||
type
|
||||
|
||||
@ -26,23 +26,34 @@ type
|
||||
memoTypeNames: TMemo;
|
||||
Panel1: TPanel;
|
||||
Panel2: TPanel;
|
||||
pnlCurConvSetting: TPanel;
|
||||
pnlCurrentConv: TPanel;
|
||||
Panel4: TPanel;
|
||||
Panel5: TPanel;
|
||||
Splitter1: TSplitter;
|
||||
procedure btnAddClick(Sender: TObject);
|
||||
procedure btnRemoveClick(Sender: TObject);
|
||||
procedure dropActionChange(Sender: TObject);
|
||||
procedure lstConvertersClick(Sender: TObject);
|
||||
procedure lstConvertersItemClick(Sender: TObject; Index: integer);
|
||||
procedure Splitter1CanOffset(Sender: TObject; var NewOffset: Integer;
|
||||
var Accept: Boolean);
|
||||
private
|
||||
FValConvList: TIdeFpDbgConverterConfigList;
|
||||
FCurIdx: Integer;
|
||||
FCurValConv: TIdeFpDbgConverterConfig;
|
||||
FCurConvConf: TIdeFpDbgConverterConfig;
|
||||
FCurConv: TLazDbgValueConverterIntf;
|
||||
FCurConvSettings: TLazDbgValueConverterSettingsFrameIntf;
|
||||
|
||||
procedure SetCurConv(AValConv: TIdeFpDbgConverterConfig);
|
||||
procedure UpdateConvForClass;
|
||||
procedure UpdateConvPanel;
|
||||
procedure FillList;
|
||||
procedure UpdateButtons;
|
||||
procedure SetValConvList(AValue: TIdeFpDbgConverterConfigList);
|
||||
public
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure SaveCurrent;
|
||||
procedure Setup;
|
||||
|
||||
@ -67,7 +78,7 @@ begin
|
||||
|
||||
SaveCurrent;
|
||||
|
||||
FCurValConv := nil;
|
||||
FCurConvConf := nil;
|
||||
AvailClass := ValueConverterClassList;
|
||||
obj := TIdeFpDbgConverterConfig.Create(AvailClass[0].Create);
|
||||
obj.Enabled := True;
|
||||
@ -86,7 +97,7 @@ var
|
||||
i: Integer;
|
||||
begin
|
||||
SaveCurrent;
|
||||
FCurValConv := nil;
|
||||
FCurConvConf := nil;
|
||||
i := lstConverters.ItemIndex;
|
||||
FValConvList.Delete(i);
|
||||
|
||||
@ -97,6 +108,11 @@ begin
|
||||
lstConvertersClick(nil);
|
||||
end;
|
||||
|
||||
procedure TFpDbgValConvFrame.dropActionChange(Sender: TObject);
|
||||
begin
|
||||
UpdateConvForClass;
|
||||
end;
|
||||
|
||||
procedure TFpDbgValConvFrame.lstConvertersClick(Sender: TObject);
|
||||
var
|
||||
AvailClass: TFpDbgValueConverterClassList;
|
||||
@ -107,20 +123,20 @@ begin
|
||||
FCurIdx := lstConverters.ItemIndex;
|
||||
if FCurIdx >= FValConvList.Count then begin
|
||||
FCurIdx := -1;
|
||||
FCurValConv := nil;
|
||||
FCurConvConf := nil;
|
||||
lblDesc.Caption := '';
|
||||
EdName.Text := '';
|
||||
memoTypeNames.Text := '';
|
||||
end
|
||||
else
|
||||
FCurValConv := FValConvList[FCurIdx];
|
||||
SetCurConv(FValConvList[FCurIdx]);
|
||||
|
||||
lblDesc.Caption := FCurValConv.Converter.GetName;
|
||||
EdName.Text := FCurValConv.Name;
|
||||
memoTypeNames.Text := FCurValConv.MatchTypeNames.Text;
|
||||
lblDesc.Caption := FCurConvConf.Converter.GetName;
|
||||
EdName.Text := FCurConvConf.Name;
|
||||
memoTypeNames.Text := FCurConvConf.MatchTypeNames.Text;
|
||||
|
||||
AvailClass := ValueConverterClassList;
|
||||
dropAction.ItemIndex := AvailClass.IndexOf(TFpDbgValueConverterClass(FCurValConv.Converter.ClassType));
|
||||
dropAction.ItemIndex := AvailClass.IndexOf(TFpDbgValueConverterClass(FCurConvConf.Converter.ClassType));
|
||||
|
||||
lstConvertersItemClick(nil, FCurIdx);
|
||||
end;
|
||||
@ -141,12 +157,55 @@ begin
|
||||
UpdateButtons;
|
||||
end;
|
||||
|
||||
procedure TFpDbgValConvFrame.Splitter1CanOffset(Sender: TObject;
|
||||
var NewOffset: Integer; var Accept: Boolean);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TFpDbgValConvFrame.SetCurConv(AValConv: TIdeFpDbgConverterConfig);
|
||||
begin
|
||||
FCurConvConf := AValConv;
|
||||
FCurConv := TLazDbgValueConvertSelectorIntf(FCurConvConf).GetConverter;
|
||||
UpdateConvPanel;
|
||||
end;
|
||||
|
||||
procedure TFpDbgValConvFrame.UpdateConvForClass;
|
||||
var
|
||||
AvailClass: TFpDbgValueConverterClassList;
|
||||
begin
|
||||
if FCurConvConf = nil then
|
||||
exit;
|
||||
|
||||
AvailClass := ValueConverterClassList;
|
||||
if (dropAction.ItemIndex <> AvailClass.IndexOf(TFpDbgValueConverterClass(FCurConv.GetObject.ClassType))) then begin
|
||||
FCurConv := AvailClass[dropAction.ItemIndex].Create;
|
||||
UpdateConvPanel;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFpDbgValConvFrame.UpdateConvPanel;
|
||||
var
|
||||
F: TFrame;
|
||||
begin
|
||||
if FCurConvSettings <> nil then
|
||||
FCurConvSettings.Free;
|
||||
|
||||
FCurConvSettings := FCurConv.GetSettingsFrame;
|
||||
if FCurConvSettings <> nil then begin
|
||||
F := TFrame(FCurConvSettings.GetFrame);
|
||||
F.Parent := pnlCurConvSetting;
|
||||
F.Align := alClient;
|
||||
FCurConvSettings.ReadFrom(FCurConv);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFpDbgValConvFrame.FillList;
|
||||
var
|
||||
i: Integer;
|
||||
obj: TIdeFpDbgConverterConfig;
|
||||
begin
|
||||
FCurValConv := nil;
|
||||
FCurConvConf := nil;
|
||||
|
||||
lstConverters.Clear;
|
||||
for i := 0 to FValConvList.Count - 1 do begin
|
||||
@ -160,14 +219,14 @@ procedure TFpDbgValConvFrame.UpdateButtons;
|
||||
begin
|
||||
btnAdd.Enabled := ValueConverterClassList.Count > 0;
|
||||
btnRemove.Enabled := (lstConverters.Count > 0) and (lstConverters.ItemIndex >= 0);
|
||||
pnlCurrentConv.Enabled := FCurValConv <> nil;
|
||||
pnlCurrentConv.Enabled := FCurConvConf <> nil;
|
||||
end;
|
||||
|
||||
procedure TFpDbgValConvFrame.SetValConvList(AValue: TIdeFpDbgConverterConfigList);
|
||||
begin
|
||||
if FValConvList = AValue then Exit;
|
||||
FValConvList := AValue;
|
||||
FCurValConv := nil;
|
||||
FCurConvConf := nil;
|
||||
|
||||
FillList;
|
||||
|
||||
@ -182,21 +241,20 @@ procedure TFpDbgValConvFrame.SaveCurrent;
|
||||
var
|
||||
AvailClass: TFpDbgValueConverterClassList;
|
||||
begin
|
||||
if FCurValConv = nil then
|
||||
if FCurConvConf = nil then
|
||||
exit;
|
||||
|
||||
AvailClass := ValueConverterClassList;
|
||||
if (TrimSet(FCurValConv.MatchTypeNames.Text, [#1..#32]) <> TrimSet(memoTypeNames.Text, [#1..#32])) or
|
||||
(dropAction.ItemIndex <> AvailClass.IndexOf(TFpDbgValueConverterClass(FCurValConv.Converter.ClassType))) or
|
||||
(EdName.Text <> FCurValConv.Name)
|
||||
if ( (FCurConv = nil) or (FCurConvSettings = nil) or FCurConvSettings.WriteTo(FCurConv) ) or
|
||||
(TrimSet(FCurConvConf.MatchTypeNames.Text, [#1..#32]) <> TrimSet(memoTypeNames.Text, [#1..#32])) or
|
||||
(FCurConvConf.Converter <> FCurConv) or
|
||||
(EdName.Text <> FCurConvConf.Name)
|
||||
then begin
|
||||
FValConvList.Changed := True;
|
||||
if (dropAction.ItemIndex <> AvailClass.IndexOf(TFpDbgValueConverterClass(FCurValConv.Converter.ClassType))) then begin
|
||||
FCurValConv.Converter := AvailClass[dropAction.ItemIndex].Create;
|
||||
FCurValConv.MatchKinds := FCurValConv.Converter.GetSupportedKinds;
|
||||
end;
|
||||
FCurValConv.MatchTypeNames.Text := memoTypeNames.Text;
|
||||
FCurValConv.Name := EdName.Text
|
||||
FCurConvConf.Converter := TFpDbgValueConverter(FCurConv.GetObject);
|
||||
FCurConvConf.MatchKinds := FCurConvConf.Converter.GetSupportedKinds;
|
||||
FCurConvConf.MatchTypeNames.Text := memoTypeNames.Text;
|
||||
FCurConvConf.Name := EdName.Text
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -211,7 +269,7 @@ begin
|
||||
lblTypeNames.Caption := dlgFpConvOptMatchTypesByName;
|
||||
lblAction.Caption := dlgFpConvOptAction;
|
||||
|
||||
FCurValConv := nil;
|
||||
FCurConvConf := nil;
|
||||
lblDesc.Caption := '-';
|
||||
|
||||
dropAction.Clear;
|
||||
@ -228,5 +286,13 @@ begin
|
||||
Setup;
|
||||
end;
|
||||
|
||||
destructor TFpDbgValConvFrame.Destroy;
|
||||
begin
|
||||
if FCurConvSettings <> nil then
|
||||
FCurConvSettings.Free;
|
||||
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user