mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-11 21:55:56 +02:00
Debugger: FpDebug, LazDebuggerIntf, Inspect-Win, basic distinction for proc/func/ref types.
This commit is contained in:
Martin
parent
e5e1ea1366
commit
f65d3b93ee
@ -6,7 +6,8 @@ interface
|
||||
|
||||
uses
|
||||
FpDbgInfo, FpPascalBuilder, FpdMemoryTools, FpErrorMessages, FpDbgDwarf,
|
||||
DbgIntfBaseTypes, fgl, SysUtils, LazDebuggerIntf;
|
||||
FpDbgDwarfDataClasses, DbgIntfBaseTypes, LazClasses, fgl, Math, SysUtils,
|
||||
LazDebuggerIntf;
|
||||
|
||||
type
|
||||
|
||||
@ -43,6 +44,8 @@ type
|
||||
|
||||
function StructToResData(AnFpValue: TFpValue; AnResData: TLzDbgWatchDataIntf): Boolean;
|
||||
|
||||
function ProcToResData(AnFpValue: TFpValue; AnResData: TLzDbgWatchDataIntf): Boolean;
|
||||
|
||||
function DoWriteWatchResultData(AnFpValue: TFpValue;
|
||||
AnResData: TLzDbgWatchDataIntf
|
||||
): Boolean;
|
||||
@ -507,6 +510,54 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFpWatchResultConvertor.ProcToResData(AnFpValue: TFpValue;
|
||||
AnResData: TLzDbgWatchDataIntf): Boolean;
|
||||
var
|
||||
addr: TDBGPtr;
|
||||
s, LocName, TpName: String;
|
||||
t, sym: TFpSymbol;
|
||||
proc: TFpSymbolDwarf;
|
||||
par: TFpValueDwarf;
|
||||
begin
|
||||
Result := True;
|
||||
addr := AnFpValue.DataAddress.Address;
|
||||
|
||||
LocName := '';
|
||||
if AnFpValue.Kind in [skFunctionRef, skProcedureRef] then begin
|
||||
t := AnFpValue.TypeInfo;
|
||||
sym := AnFpValue.DbgSymbol;
|
||||
proc := nil;
|
||||
if (sym <> nil) and (sym is TFpSymbolDwarfDataProc) then
|
||||
proc := TFpSymbolDwarf(sym)
|
||||
else
|
||||
if t <> nil then
|
||||
proc := TFpSymbolDwarf(TDbgDwarfSymbolBase(t).CompilationUnit.Owner.FindProcSymbol(addr));
|
||||
|
||||
if proc <> nil then begin
|
||||
LocName := proc.Name;
|
||||
if (proc is TFpSymbolDwarfDataProc) then begin
|
||||
par := TFpSymbolDwarfDataProc(proc).GetSelfParameter; // Has no Context set, but we only need TypeInfo.Name
|
||||
if (par <> nil) and (par.TypeInfo <> nil) then
|
||||
LocName := par.TypeInfo.Name + '.' + LocName;
|
||||
par.ReleaseReference;
|
||||
end;
|
||||
ReleaseRefAndNil(proc);
|
||||
end;
|
||||
end
|
||||
else
|
||||
t := AnFpValue.DbgSymbol;
|
||||
|
||||
GetTypeAsDeclaration(s, t);
|
||||
|
||||
case AnFpValue.Kind of
|
||||
skProcedure: AnResData.CreateProcedure(addr, False, LocName, s);
|
||||
skFunction: AnResData.CreateProcedure(addr, True, LocName, s);
|
||||
skProcedureRef: AnResData.CreateProcedureRef(addr, False, LocName, s);
|
||||
skFunctionRef: AnResData.CreateProcedureRef(addr, True, LocName, s);
|
||||
end;
|
||||
AddTypeNameToResData(AnFpValue, AnResData);
|
||||
end;
|
||||
|
||||
function TFpWatchResultConvertor.DoWriteWatchResultData(AnFpValue: TFpValue;
|
||||
AnResData: TLzDbgWatchDataIntf): Boolean;
|
||||
var
|
||||
@ -550,10 +601,10 @@ begin
|
||||
skType: ;
|
||||
skInstance: ;
|
||||
skUnit: ;
|
||||
skProcedure: ;
|
||||
skFunction: ;
|
||||
skProcedureRef: ;
|
||||
skFunctionRef: ;
|
||||
skProcedure,
|
||||
skFunction,
|
||||
skProcedureRef,
|
||||
skFunctionRef: Result := ProcToResData(AnFpValue, AnResData);
|
||||
skSimple: ;
|
||||
skBoolean: Result := BoolToResData(AnFpValue, AnResData);
|
||||
skCurrency: ;
|
||||
|
||||
@ -148,14 +148,15 @@ type
|
||||
// // CreateSetValue: "ASetVal" only has "length(ANames)" entries. Any higher value will be ignored / should be zero
|
||||
// procedure CreateSetValue(const ASetVal: TLzDbgSetData; const ANames: TStringDynArray); //; const AOrdValues: array of Integer);
|
||||
|
||||
//temporary
|
||||
function CreateProcedure(AVal: TDBGPtr; AnIsFunction: Boolean; ALoc, ADesc: String): TLzDbgWatchDataIntf;
|
||||
function CreateProcedureRef(AVal: TDBGPtr; AnIsFunction: Boolean; ALoc, ADesc: String): TLzDbgWatchDataIntf;
|
||||
|
||||
// Returns Intf for setting element-type => for empty array
|
||||
function CreateArrayValue(AnArrayType: TLzDbgArrayType;
|
||||
ATotalCount: Integer = 0;
|
||||
ALowIdx: Integer = 0
|
||||
): TLzDbgWatchDataIntf;
|
||||
//procedure CreateDynArrayValue(ATotalCount: Integer = 0);
|
||||
//procedure CreateStatArrayValue(ATotalCount: Integer = 0);
|
||||
// low/high
|
||||
|
||||
procedure CreateStructure(AStructType: TLzDbgStructType;
|
||||
ADataAddress: TDBGPtr = 0
|
||||
|
||||
@ -38,8 +38,8 @@ uses
|
||||
LazDebuggerIntfBaseTypes,
|
||||
// IDE
|
||||
LazarusIDEStrConsts, BaseDebugManager, InputHistory, IDEProcs, Debugger,
|
||||
IdeDebuggerWatchResPrinter, IdeDebuggerWatchResult, DebuggerDlg,
|
||||
DebuggerStrConst, EnvironmentOpts;
|
||||
IdeDebuggerWatchResPrinter, IdeDebuggerWatchResult, IdeDebuggerWatchResUtils,
|
||||
DebuggerDlg, DebuggerStrConst, EnvironmentOpts;
|
||||
|
||||
type
|
||||
|
||||
@ -316,7 +316,6 @@ end;
|
||||
procedure TIDEInspectDlg.InspectResDataArray;
|
||||
var
|
||||
Res, Entry: TWatchResultData;
|
||||
v: String;
|
||||
b: Int64;
|
||||
i: Integer;
|
||||
begin
|
||||
@ -355,19 +354,13 @@ const
|
||||
FieldLocationNames: array[TLzDbgFieldVisibility] of string = //(dfvUnknown, dfvPrivate, dfvProtected, dfvPublic, dfvPublished);
|
||||
('', 'Private', 'Protected', 'Public', 'Published');
|
||||
var
|
||||
Res: TWatchResultData;
|
||||
cnt, i: Integer;
|
||||
Res, Fld, Fld2: TWatchResultData;
|
||||
i, FldCnt, MethCnt, f, m: Integer;
|
||||
FldInfo: TWatchResultDataFieldInfo;
|
||||
AnchType: String;
|
||||
begin
|
||||
Res := FCurrentWatchValue.ResultData;
|
||||
|
||||
DataPage.TabVisible :=true;
|
||||
PropertiesPage.TabVisible :=false;
|
||||
MethodsPage.TabVisible := False; // TODO
|
||||
//if not (PageControl.ActivePage = MethodsPage) then
|
||||
PageControl.ActivePage := DataPage;
|
||||
|
||||
FGridData.Columns[0].Visible := (Res.StructType in [dstClass, dstObject]) and btnColClass.Down; // anchestor
|
||||
FGridData.Columns[2].Visible := btnColType.Down; // typename
|
||||
FGridData.Columns[4].Visible := (Res.StructType in [dstClass, dstObject]) and btnColVisibility.Down; // class-visibility
|
||||
@ -382,27 +375,97 @@ begin
|
||||
StatusBar1.SimpleText:=Format(lisInspectClassInherit, [ShortenedExpression, Res.TypeName, AnchType]);
|
||||
|
||||
GridDataSetup;
|
||||
cnt := Res.FieldCount; // TODO: filter method vs field
|
||||
FGridData.RowCount := max(cnt+1, 2);
|
||||
for i := 1 to cnt do begin
|
||||
FldCnt := 0;
|
||||
MethCnt := 0;
|
||||
|
||||
if Res.StructType in [dstClass, dstObject] then begin
|
||||
for i := 1 to Res.FieldCount do begin
|
||||
FldInfo := Res.Fields[i-1];
|
||||
if (FldInfo.Field <> nil) and
|
||||
( (FldInfo.Field.ValueKind in [rdkFunction, rdkProcedure, rdkFunctionRef, rdkProcedureRef]) or
|
||||
(ExtractProcResFromMethod(FldInfo.Field) <> nil)
|
||||
)
|
||||
then
|
||||
inc(MethCnt)
|
||||
else
|
||||
inc(FldCnt);
|
||||
end;
|
||||
end
|
||||
else
|
||||
FldCnt := Res.FieldCount;
|
||||
|
||||
DataPage.TabVisible := FldCnt > 0;
|
||||
PropertiesPage.TabVisible :=false;
|
||||
MethodsPage.TabVisible := MethCnt > 0;
|
||||
if not (PageControl.ActivePage = MethodsPage) then
|
||||
PageControl.ActivePage := DataPage;
|
||||
|
||||
FGridData.RowCount := max(FldCnt+1, 2);
|
||||
FGridMethods.RowCount := max(MethCnt+1, 2);
|
||||
f := 1;
|
||||
m := 1;
|
||||
for i := 1 to Res.FieldCount do begin
|
||||
FldInfo := Res.Fields[i-1];
|
||||
|
||||
FGridData.Cells[1,i] := FldInfo.FieldName;
|
||||
if FldInfo.Field <> nil
|
||||
then FGridData.Cells[2,i] := FldInfo.Field.TypeName
|
||||
else FGridData.Cells[2,i] := '';
|
||||
if FldInfo.Field <> nil
|
||||
then FGridData.Cells[3,i] := FWatchPrinter.PrintWatchValue(FldInfo.Field, wdfDefault)
|
||||
else FGridData.Cells[3,i] := '<error>';
|
||||
Fld := FldInfo.Field;
|
||||
Fld2 := ExtractProcResFromMethod(Fld);
|
||||
if (MethCnt > 0) and
|
||||
(Fld <> nil) and
|
||||
( (Fld.ValueKind in [rdkFunction, rdkProcedure, rdkFunctionRef, rdkProcedureRef]) or
|
||||
(Fld2 <> nil)
|
||||
)
|
||||
then begin
|
||||
if Fld2 = nil then Fld2 := Fld;
|
||||
|
||||
FGridMethods.Cells[0,m] := FldInfo.FieldName;
|
||||
|
||||
if Fld <> nil then begin
|
||||
if Fld2.ValueKind in [rdkFunction, rdkProcedure] then begin
|
||||
if dffConstructor in FldInfo.FieldFlags
|
||||
then FGridMethods.Cells[1,m] := 'Constructor'
|
||||
else if dffDestructor in FldInfo.FieldFlags
|
||||
then FGridMethods.Cells[1,m] := 'Destructor'
|
||||
else if Fld2.ValueKind = rdkFunction
|
||||
then FGridMethods.Cells[1,m] := 'Function'
|
||||
else if Fld2.ValueKind = rdkPCharOrString
|
||||
then FGridMethods.Cells[1,m] := 'Procedure'
|
||||
else FGridMethods.Cells[1,m] := '';
|
||||
end
|
||||
else
|
||||
FGridMethods.Cells[1,m] := Fld.TypeName;
|
||||
end
|
||||
else
|
||||
FGridMethods.Cells[1,m] := '';
|
||||
|
||||
FGridMethods.Cells[2,m] := '';
|
||||
|
||||
if Fld2 = nil then Fld2 := Fld;
|
||||
if Fld2 <> nil
|
||||
then FGridMethods.Cells[3,m] := IntToHex(Fld2.AsQWord, 16)
|
||||
else FGridMethods.Cells[3,m] := '';
|
||||
|
||||
inc(m);
|
||||
end
|
||||
else begin
|
||||
if FldInfo.Owner <> nil
|
||||
then FGridData.Cells[0,i] := FldInfo.Owner.TypeName
|
||||
else FGridData.Cells[0,i] := '';
|
||||
FGridData.Cells[4,i] := FieldLocationNames[FldInfo.FieldVisibility];
|
||||
then FGridData.Cells[0,f] := FldInfo.Owner.TypeName
|
||||
else FGridData.Cells[0,f] := '';
|
||||
|
||||
FGridData.Cells[1,f] := FldInfo.FieldName;
|
||||
|
||||
if Fld <> nil
|
||||
then FGridData.Cells[2,f] := Fld.TypeName
|
||||
else FGridData.Cells[2,f] := '';
|
||||
|
||||
if Fld <> nil
|
||||
then FGridData.Cells[3,f] := FWatchPrinter.PrintWatchValue(Fld, wdfDefault)
|
||||
else FGridData.Cells[3,f] := '<error>';
|
||||
|
||||
FGridData.Cells[4,f] := FieldLocationNames[FldInfo.FieldVisibility];
|
||||
|
||||
inc(f);
|
||||
end;
|
||||
end;
|
||||
|
||||
//GridMethodsSetup;
|
||||
//ShowMethodsFields;
|
||||
end;
|
||||
|
||||
procedure TIDEInspectDlg.DataGridMouseDown(Sender: TObject; Button: TMouseButton;
|
||||
@ -1226,7 +1289,11 @@ begin
|
||||
rdkUnsignedNumVal,
|
||||
rdkFloatVal,
|
||||
rdkBool,
|
||||
rdkPCharOrString: InspectResDataSimple;
|
||||
rdkPCharOrString,
|
||||
rdkFunction,
|
||||
rdkProcedure,
|
||||
rdkFunctionRef,
|
||||
rdkProcedureRef: InspectResDataSimple;
|
||||
rdkPointerVal: InspectResDataPointer;
|
||||
rdkEnum: InspectResDataEnum;
|
||||
rdkEnumVal: InspectResDataEnum;
|
||||
|
||||
@ -694,6 +694,8 @@ type
|
||||
procedure CreateNumValue(ANumValue: QWord; ASigned: Boolean; AByteSize: Integer = 0); virtual;
|
||||
procedure CreatePointerValue(AnAddrValue: TDbgPtr); virtual;
|
||||
procedure CreateFloatValue(AFloatValue: Extended; APrecission: TLzDbgFloatPrecission); virtual;
|
||||
function CreateProcedure(AVal: TDBGPtr; AnIsFunction: Boolean; ALoc, ADesc: String): TLzDbgWatchDataIntf;
|
||||
function CreateProcedureRef(AVal: TDBGPtr; AnIsFunction: Boolean; ALoc, ADesc: String): TLzDbgWatchDataIntf;
|
||||
function CreateArrayValue(AnArrayType: TLzDbgArrayType;
|
||||
ATotalCount: Integer = 0;
|
||||
ALowIdx: Integer = 0
|
||||
@ -3594,6 +3596,53 @@ begin
|
||||
AfterDataCreated;
|
||||
end;
|
||||
|
||||
function TCurrentResData.CreateProcedure(AVal: TDBGPtr; AnIsFunction: Boolean;
|
||||
ALoc, ADesc: String): TLzDbgWatchDataIntf;
|
||||
begin
|
||||
BeforeCreateValue;
|
||||
if AnIsFunction then begin
|
||||
assert((FNewResultData=nil) or (FNewResultData.ValueKind = rdkFunction), 'TCurrentResData.CreateProcedure: (FNewResultData=nil) or (FNewResultData.ValueKind = rdkFunction]');
|
||||
if FNewResultData = nil then
|
||||
FNewResultData := TWatchResultDataFunc.Create(AVal, ALoc, ADesc)
|
||||
else
|
||||
TWatchResultDataFunc(FNewResultData).Create(AVal, ALoc, ADesc);
|
||||
end
|
||||
else begin
|
||||
assert((FNewResultData=nil) or (FNewResultData.ValueKind = rdkProcedure), 'TCurrentResData.CreateProcedure: (FNewResultData=nil) or (FNewResultData.ValueKind = rdkProcedure]');
|
||||
if FNewResultData = nil then
|
||||
FNewResultData := TWatchResultDataProc.Create(AVal, ALoc, ADesc)
|
||||
else
|
||||
TWatchResultDataProc(FNewResultData).Create(AVal, ALoc, ADesc);
|
||||
end;
|
||||
AfterDataCreated;
|
||||
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function TCurrentResData.CreateProcedureRef(AVal: TDBGPtr;
|
||||
AnIsFunction: Boolean; ALoc, ADesc: String): TLzDbgWatchDataIntf;
|
||||
begin
|
||||
BeforeCreateValue;
|
||||
if AnIsFunction then begin
|
||||
assert((FNewResultData=nil) or (FNewResultData.ValueKind = rdkFunctionRef), 'TCurrentResData.CreateProcedureRef: (FNewResultData=nil) or (FNewResultData.ValueKind = rdkFunctionRef]');
|
||||
if FNewResultData = nil then
|
||||
FNewResultData := TWatchResultDataFuncRef.Create(AVal, ALoc, ADesc)
|
||||
else
|
||||
TWatchResultDataFuncRef(FNewResultData).Create(AVal, ALoc, ADesc);
|
||||
end
|
||||
else begin
|
||||
assert((FNewResultData=nil) or (FNewResultData.ValueKind = rdkProcedureRef), 'TCurrentResData.CreateProcedureRef: (FNewResultData=nil) or (FNewResultData.ValueKind = rdkProcedureRef]');
|
||||
if FNewResultData = nil then
|
||||
FNewResultData := TWatchResultDataProcRef.Create(AVal, ALoc, ADesc)
|
||||
else
|
||||
TWatchResultDataProcRef(FNewResultData).Create(AVal, ALoc, ADesc);
|
||||
end;
|
||||
AfterDataCreated;
|
||||
|
||||
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
procedure TCurrentResData.CreateBoolValue(AnOrdBoolValue: QWord;
|
||||
AByteSize: Integer);
|
||||
begin
|
||||
|
||||
@ -54,7 +54,11 @@
|
||||
</Item>
|
||||
<Item>
|
||||
<Filename Value="idedebuggerwatchresprinter.pas"/>
|
||||
<UnitName Value="idedebuggerwatchresprinter"/>
|
||||
<UnitName Value="IdeDebuggerWatchResPrinter"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Filename Value="idedebuggerwatchresutils.pas"/>
|
||||
<UnitName Value="IdeDebuggerWatchResUtils"/>
|
||||
</Item>
|
||||
</Files>
|
||||
<RequiredPkgs>
|
||||
|
||||
@ -10,7 +10,7 @@ interface
|
||||
uses
|
||||
IdeDebuggerBase, Debugger, ProcessDebugger, ProcessList, DebuggerTreeView,
|
||||
IdeDebuggerUtils, IdeDebuggerWatchResult, IdeDebuggerWatchResPrinter,
|
||||
LazarusPackageIntf;
|
||||
IdeDebuggerWatchResUtils, LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
@ -19,6 +19,7 @@ type
|
||||
function PrintNumber(ANumValue: TWatchResultData; AnIsPointer: Boolean; ADispFormat: TWatchDisplayFormat): String;
|
||||
function PrintArray(AResValue: TWatchResultData; ADispFormat: TWatchDisplayFormat; ANestLvl: Integer): String;
|
||||
function PrintStruct(AResValue: TWatchResultData; ADispFormat: TWatchDisplayFormat; ANestLvl: Integer): String;
|
||||
function PrintProc(AResValue: TWatchResultData; ADispFormat: TWatchDisplayFormat; ANestLvl: Integer): String;
|
||||
|
||||
function PrintWatchValueEx(AResValue: TWatchResultData; ADispFormat: TWatchDisplayFormat; ANestLvl: Integer): String;
|
||||
public
|
||||
@ -204,6 +205,35 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TWatchResultPrinter.PrintProc(AResValue: TWatchResultData;
|
||||
ADispFormat: TWatchDisplayFormat; ANestLvl: Integer): String;
|
||||
var
|
||||
s: String;
|
||||
begin
|
||||
if AResValue.AsQWord = 0 then
|
||||
Result := 'nil'
|
||||
else
|
||||
Result := PrintNumber(AResValue, True, wdfHex);
|
||||
|
||||
if AResValue.AsString <> '' then
|
||||
Result := Result + ' = ' + AResValue.AsString;
|
||||
|
||||
if ANestLvl > 0 then begin
|
||||
s := AResValue.TypeName;
|
||||
end
|
||||
else begin
|
||||
s := AResValue.AsDesc;
|
||||
if s = '' then
|
||||
s := AResValue.TypeName;
|
||||
end;
|
||||
|
||||
if s <> '' then
|
||||
if AResValue.ValueKind in [rdkFunctionRef, rdkProcedureRef] then
|
||||
Result := Result + ': '+s
|
||||
else
|
||||
Result := s + ' AT ' +Result;
|
||||
end;
|
||||
|
||||
function TWatchResultPrinter.PrintWatchValueEx(AResValue: TWatchResultData;
|
||||
ADispFormat: TWatchDisplayFormat; ANestLvl: Integer): String;
|
||||
|
||||
@ -312,11 +342,18 @@ begin
|
||||
end;
|
||||
end;
|
||||
rdkPointerVal: begin
|
||||
PtrDeref := PointerValue.DerefData;
|
||||
ResTypeName := '';
|
||||
if (ADispFormat = wdfStructure) or
|
||||
((ADispFormat = wdfDefault) and (PointerValue.DerefData = nil))
|
||||
then
|
||||
then begin
|
||||
ResTypeName := AResValue.TypeName;
|
||||
if (ResTypeName = '') and (PtrDeref <> nil) then begin
|
||||
ResTypeName := PtrDeref.TypeName;
|
||||
if ResTypeName <> '' then
|
||||
ResTypeName := '^'+ResTypeName;
|
||||
end;
|
||||
end;
|
||||
|
||||
if (ADispFormat in [wdfDefault, wdfStructure, wdfPointer]) and (AResValue.AsQWord = 0)
|
||||
then begin
|
||||
@ -333,7 +370,6 @@ begin
|
||||
if ResTypeName <> '' then
|
||||
Result := ResTypeName + '(' + Result + ')';
|
||||
|
||||
PtrDeref := PointerValue.DerefData;
|
||||
if PtrDeref <> nil then begin
|
||||
while (PtrDeref.ValueKind = rdkPointerVal) and (PtrDeref.DerefData <> nil) do begin
|
||||
Result := Result + '^';
|
||||
@ -365,6 +401,10 @@ begin
|
||||
end;
|
||||
rdkArray: Result := PrintArray(AResValue, ADispFormat, ANestLvl);
|
||||
rdkStruct: Result := PrintStruct(AResValue, ADispFormat, ANestLvl);
|
||||
rdkFunction,
|
||||
rdkProcedure,
|
||||
rdkFunctionRef,
|
||||
rdkProcedureRef: Result := PrintProc(AResValue, ADispFormat, ANestLvl);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -19,7 +19,9 @@ type
|
||||
rdkBool, rdkEnum, rdkEnumVal, rdkSet,
|
||||
rdkPCharOrString,
|
||||
rdkArray,
|
||||
rdkStruct
|
||||
rdkStruct,
|
||||
rdkFunction, rdkProcedure,
|
||||
rdkFunctionRef, rdkProcedureRef
|
||||
);
|
||||
TWatchResultData = class;
|
||||
TWatchResultDataError = class;
|
||||
@ -454,6 +456,40 @@ type
|
||||
end;
|
||||
|
||||
|
||||
{ TWatchResultTypeProc }
|
||||
|
||||
TWatchResultTypeProc = object(TWatchResultValue)
|
||||
private
|
||||
FText: String;
|
||||
FLoc: String;
|
||||
protected
|
||||
property GetAsString: String read FText;
|
||||
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);
|
||||
end;
|
||||
|
||||
TWatchResultValueFunc = object(TWatchResultValueOrdNumBase)
|
||||
protected const
|
||||
VKind = rdkFunction;
|
||||
end;
|
||||
|
||||
TWatchResultValueProc = object(TWatchResultValueOrdNumBase)
|
||||
protected const
|
||||
VKind = rdkProcedure;
|
||||
end;
|
||||
|
||||
TWatchResultValueFuncRef = object(TWatchResultValueOrdNumBase)
|
||||
protected const
|
||||
VKind = rdkFunctionRef;
|
||||
end;
|
||||
|
||||
TWatchResultValueProcRef = object(TWatchResultValueOrdNumBase)
|
||||
protected const
|
||||
VKind = rdkProcedureRef;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
@ -555,6 +591,10 @@ type
|
||||
wdStatA, // TWatchResultDataStatArray
|
||||
wdStruct, // TWatchResultDataStruct
|
||||
wdStructRef, // TWatchResultDataRefStruct
|
||||
wdFunc, // TWatchResultDataFunc,
|
||||
wdProc, // TWatchResultDataProc,
|
||||
wdFuncRef, // TWatchResultDataFuncRef,
|
||||
wdProcRef, // TWatchResultDataProcRef,
|
||||
wdErr // TWatchResultDataError
|
||||
);
|
||||
|
||||
@ -599,6 +639,7 @@ type
|
||||
protected
|
||||
function GetValueKind: TWatchResultDataKind; virtual; //abstract;
|
||||
function GetAsString: String; virtual; abstract;
|
||||
function GetAsDesc: String; virtual; abstract;
|
||||
function GetAsWideString: WideString; virtual; abstract;
|
||||
function GetAsQWord: QWord; virtual; abstract;
|
||||
function GetAsInt64: Int64; virtual; abstract;
|
||||
@ -646,6 +687,7 @@ type
|
||||
property TypeName: String read FTypeName;
|
||||
|
||||
property AsString: String read GetAsString;
|
||||
property AsDesc: String read GetAsDesc;
|
||||
property AsWideString: WideString read GetAsWideString;
|
||||
property AsQWord: QWord read GetAsQWord;
|
||||
property AsInt64: Int64 read GetAsInt64;
|
||||
@ -824,6 +866,7 @@ type
|
||||
protected
|
||||
function GetValueKind: TWatchResultDataKind; override;
|
||||
function GetAsString: String; override;
|
||||
function GetAsDesc: String; override;
|
||||
function GetAsWideString: WideString; override;
|
||||
function GetAsQWord: QWord; override;
|
||||
function GetAsInt64: Int64; override;
|
||||
@ -1208,6 +1251,48 @@ type
|
||||
|
||||
|
||||
|
||||
|
||||
{ TGenericWatchResultDataProc }
|
||||
|
||||
generic TGenericWatchResultDataProc<_DATA> = class(specialize TGenericWatchResultDataWithType<_DATA, TWatchResultTypeProc>)
|
||||
protected
|
||||
function GetAsString: String; override; // TODO
|
||||
function GetAsDesc: String; override;
|
||||
public
|
||||
constructor Create(AnAddr: QWord; ALoc, ADesc: String);
|
||||
end;
|
||||
|
||||
{ TWatchResultDataFunc }
|
||||
|
||||
TWatchResultDataFunc = class(specialize TGenericWatchResultDataProc<TWatchResultValueProc>)
|
||||
private
|
||||
function GetClassID: TWatchResultDataClassID; override;
|
||||
end;
|
||||
|
||||
{ TWatchResultDataProc }
|
||||
|
||||
TWatchResultDataProc = class(specialize TGenericWatchResultDataProc<TWatchResultValueProc>)
|
||||
private
|
||||
function GetClassID: TWatchResultDataClassID; override;
|
||||
end;
|
||||
|
||||
{ TWatchResultDataFuncRef }
|
||||
|
||||
TWatchResultDataFuncRef = class(specialize TGenericWatchResultDataProc<TWatchResultValueProcRef>)
|
||||
private
|
||||
function GetClassID: TWatchResultDataClassID; override;
|
||||
end;
|
||||
|
||||
{ TWatchResultDataProcRef }
|
||||
|
||||
TWatchResultDataProcRef = class(specialize TGenericWatchResultDataProc<TWatchResultValueProcRef>)
|
||||
private
|
||||
function GetClassID: TWatchResultDataClassID; override;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
{ TWatchResultDataError }
|
||||
|
||||
TWatchResultDataError = class(specialize TGenericWatchResultData<TWatchResultValueError>)
|
||||
@ -1260,6 +1345,10 @@ const
|
||||
TWatchResultDataStatArray, // wdStatA,
|
||||
TWatchResultDataStruct, // wdStruct
|
||||
TWatchResultDataRefStruct, // wdStructRef
|
||||
TWatchResultDataFunc, // wdFunc
|
||||
TWatchResultDataProc, // wdProc
|
||||
TWatchResultDataFuncRef, // wdFuncRef
|
||||
TWatchResultDataProcRef, // wdProcRef
|
||||
TWatchResultDataError // wdErr
|
||||
);
|
||||
|
||||
@ -1905,6 +1994,24 @@ begin
|
||||
FAnchestor.Free;
|
||||
end;
|
||||
|
||||
{ TWatchResultTypeProc }
|
||||
|
||||
procedure TWatchResultTypeProc.LoadDataFromXMLConfig(const AConfig: TXMLConfig;
|
||||
const APath: string; const AnEntryTemplate: TWatchResultData;
|
||||
var AnOverrideTemplate: TOverrideTemplateData; AnAsProto: Boolean);
|
||||
begin
|
||||
inherited LoadDataFromXMLConfig(AConfig, APath, AnEntryTemplate, AnOverrideTemplate, AnAsProto);
|
||||
FText := AConfig.GetValue(APath + 'Desc', '');
|
||||
|
||||
end;
|
||||
|
||||
procedure TWatchResultTypeProc.SaveDataToXMLConfig(const AConfig: TXMLConfig;
|
||||
const APath: string; AnAsProto: Boolean);
|
||||
begin
|
||||
inherited SaveDataToXMLConfig(AConfig, APath, AnAsProto);
|
||||
AConfig.SetValue(APath + 'Desc', FText);
|
||||
end;
|
||||
|
||||
{ TWatchResultStorageOverrides }
|
||||
|
||||
procedure TWatchResultStorageOverrides.Assign(
|
||||
@ -2672,6 +2779,11 @@ begin
|
||||
Result := FData.GetAsString;
|
||||
end;
|
||||
|
||||
function TGenericWatchResultData.GetAsDesc: String;
|
||||
begin
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
function TGenericWatchResultData.GetAsWideString: WideString;
|
||||
begin
|
||||
Result := FData.GetAsWideString;
|
||||
@ -3895,6 +4007,55 @@ begin
|
||||
inherited Create(AStructType);
|
||||
end;
|
||||
|
||||
{ TGenericWatchResultDataProc }
|
||||
|
||||
function TGenericWatchResultDataProc.GetAsString: String;
|
||||
begin
|
||||
Result := FType.FLoc;
|
||||
end;
|
||||
|
||||
function TGenericWatchResultDataProc.GetAsDesc: String;
|
||||
begin
|
||||
Result := FType.FText;
|
||||
end;
|
||||
|
||||
constructor TGenericWatchResultDataProc.Create(AnAddr: QWord; ALoc,
|
||||
ADesc: String);
|
||||
begin
|
||||
FType.FText := ADesc;
|
||||
FType.FLoc := ALoc;
|
||||
FData.FNumValue := AnAddr;
|
||||
inherited Create();
|
||||
end;
|
||||
|
||||
{ TWatchResultDataFunc }
|
||||
|
||||
function TWatchResultDataFunc.GetClassID: TWatchResultDataClassID;
|
||||
begin
|
||||
Result := wdFunc;
|
||||
end;
|
||||
|
||||
{ TWatchResultDataProc }
|
||||
|
||||
function TWatchResultDataProc.GetClassID: TWatchResultDataClassID;
|
||||
begin
|
||||
Result := wdProc;
|
||||
end;
|
||||
|
||||
{ TWatchResultDataFuncRef }
|
||||
|
||||
function TWatchResultDataFuncRef.GetClassID: TWatchResultDataClassID;
|
||||
begin
|
||||
Result := wdFuncRef;
|
||||
end;
|
||||
|
||||
{ TWatchResultDataProcRef }
|
||||
|
||||
function TWatchResultDataProcRef.GetClassID: TWatchResultDataClassID;
|
||||
begin
|
||||
Result := wdProcRef;
|
||||
end;
|
||||
|
||||
{ TWatchResultDataError.TErrorDataStorage }
|
||||
|
||||
procedure TWatchResultDataError.TErrorDataStorage.SaveDataToXMLConfig(
|
||||
|
||||
32
ide/packages/idedebugger/idedebuggerwatchresutils.pas
Normal file
32
ide/packages/idedebugger/idedebuggerwatchresutils.pas
Normal file
@ -0,0 +1,32 @@
|
||||
unit IdeDebuggerWatchResUtils;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, IdeDebuggerWatchResult, LazDebuggerIntf;
|
||||
|
||||
function ExtractProcResFromMethod(AMethodRes: TWatchResultData): TWatchResultData;
|
||||
|
||||
implementation
|
||||
|
||||
function ExtractProcResFromMethod(AMethodRes: TWatchResultData
|
||||
): TWatchResultData;
|
||||
begin
|
||||
Result := nil;
|
||||
if (AMethodRes <> nil) and
|
||||
(AMethodRes.StructType = dstRecord) and
|
||||
(AMethodRes.FieldCount = 2) and
|
||||
(LowerCase(AMethodRes.Fields[0].FieldName) = 'proc') and
|
||||
(AMethodRes.Fields[0].Field <> nil) and
|
||||
(AMethodRes.Fields[0].Field.ValueKind in [rdkFunction, rdkProcedure, rdkFunctionRef, rdkProcedureRef]) and
|
||||
(LowerCase(AMethodRes.Fields[1].FieldName) = 'self') and
|
||||
(AMethodRes.Fields[1].Field <> nil) and
|
||||
(AMethodRes.Fields[1].Field.ValueKind = rdkStruct)
|
||||
then
|
||||
Result := AMethodRes.Fields[0].Field;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user