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

Debugger: fix typename with Json-display

Browse Source
This commit is contained in:
Martin 2022-08-03 17:47:49 +02:00
parent 3b0a985ae7
commit cbb17d6aeb
4 changed files with 48 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
debugger/inspectdlg.pas
View File

@ -370,7 +370,10 @@ begin
AnchType := '';
if Res.Anchestor <> nil then
AnchType := Res.Anchestor.TypeName;
StatusBar1.SimpleText:=Format(lisInspectClassInherit, [ShortenedExpression, Res.TypeName, AnchType]);
if (Res.ValueKind = rdkStruct) and (AnchType <> '') then
StatusBar1.SimpleText:=Format(lisInspectClassInherit, [ShortenedExpression, Res.TypeName, AnchType])
else
StatusBar1.SimpleText:=ShortenedExpression+' : '+Res.TypeName + ' = ' + FHumanReadable;
GridDataSetup;
FldCnt := 0;

3
ide/packages/idedebugger/idedebuggerbase.pas
View File

@ -277,6 +277,9 @@ begin
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;
end;

40
ide/packages/idedebugger/idedebuggerwatchresult.pas
View File

@ -96,6 +96,15 @@ type
TWatchResultValueString = object(TWatchResultValueTextBase)
protected const
VKind = rdkString;
private
FAddress: TDBGPtr;
protected
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
const AnEntryTemplate: TWatchResultData;
var AnOverrideTemplate: TOverrideTemplateData;
AnAsProto: Boolean);
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
property GetDataAddress: TDBGPtr read FAddress;
end;
{ TWatchResultValueWideString }
@ -1000,6 +1009,9 @@ type
TWatchResultDataString = class(specialize TGenericWatchResultData<TWatchResultValueString>)
private
function GetClassID: TWatchResultDataClassID; override;
protected
function GetHasDataAddress: Boolean; override;
function GetDataAddress: TDBGPtr; override;
public
constructor Create(AStringVal: String);
end;
@ -1594,6 +1606,24 @@ begin
AConfig.SetValue(APath + 'Value', FText);
end;
{ TWatchResultValueString }
procedure TWatchResultValueString.LoadDataFromXMLConfig(
const AConfig: TXMLConfig; const APath: string;
const AnEntryTemplate: TWatchResultData;
var AnOverrideTemplate: TOverrideTemplateData; AnAsProto: Boolean);
begin
inherited LoadDataFromXMLConfig(AConfig, APath, AnEntryTemplate, AnOverrideTemplate, AnAsProto);
FAddress := TDBGPtr(AConfig.GetValue(APath + 'Addr', 0));
end;
procedure TWatchResultValueString.SaveDataToXMLConfig(
const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
begin
inherited SaveDataToXMLConfig(AConfig, APath, AnAsProto);
AConfig.SetDeleteValue(APath + 'Addr', Int64(FAddress), 0);
end;
{ TWatchResultValueWideString }
function TWatchResultValueWideString.GetAsString: String;
@ -3288,6 +3318,16 @@ begin
Result := wdString;
end;
function TWatchResultDataString.GetHasDataAddress: Boolean;
begin
Result := True;
end;
function TWatchResultDataString.GetDataAddress: TDBGPtr;
begin
Result := FData.GetDataAddress;
end;
constructor TWatchResultDataString.Create(AStringVal: String);
begin
inherited Create;

2
ide/packages/idedebugger/idedebuggerwatchresultjson.pas
View File

@ -12,7 +12,7 @@ type
{ TWatchResultDataJSonBase }
TWatchResultDataJSonBase = class(TWatchResultDataPrePrinted)
TWatchResultDataJSonBase = class(TWatchResultDataString)
private
FInternalJSon: TJSONData;
FIndex: Integer;