From f65d3b93eec7e470ea2424e1b78a42042bea0022 Mon Sep 17 00:00:00 2001 From: Martin Date: Thu, 9 Jun 2022 23:06:52 +0200 Subject: [PATCH] Debugger: FpDebug, LazDebuggerIntf, Inspect-Win, basic distinction for proc/func/ref types. --- components/fpdebug/fpwatchresultdata.pas | 61 ++++++- .../lazdebuggerintf/lazdebuggerintf.pas | 7 +- debugger/inspectdlg.pas | 125 ++++++++++---- ide/packages/idedebugger/debugger.pp | 49 ++++++ ide/packages/idedebugger/idedebugger.lpk | 6 +- .../idedebugger/idedebuggerpackage.pas | 2 +- .../idedebuggerwatchresprinter.pas | 44 ++++- .../idedebugger/idedebuggerwatchresult.pas | 163 +++++++++++++++++- .../idedebugger/idedebuggerwatchresutils.pas | 32 ++++ 9 files changed, 447 insertions(+), 42 deletions(-) create mode 100644 ide/packages/idedebugger/idedebuggerwatchresutils.pas diff --git a/components/fpdebug/fpwatchresultdata.pas b/components/fpdebug/fpwatchresultdata.pas index def1c7fad8..8e1a9911ba 100644 --- a/components/fpdebug/fpwatchresultdata.pas +++ b/components/fpdebug/fpwatchresultdata.pas @@ -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: ; diff --git a/components/lazdebuggers/lazdebuggerintf/lazdebuggerintf.pas b/components/lazdebuggers/lazdebuggerintf/lazdebuggerintf.pas index d26580758f..7cc1241bd1 100644 --- a/components/lazdebuggers/lazdebuggerintf/lazdebuggerintf.pas +++ b/components/lazdebuggers/lazdebuggerintf/lazdebuggerintf.pas @@ -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 diff --git a/debugger/inspectdlg.pas b/debugger/inspectdlg.pas index f51ec48b10..9622a8b8eb 100644 --- a/debugger/inspectdlg.pas +++ b/debugger/inspectdlg.pas @@ -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] := ''; - if FldInfo.Owner <> nil - then FGridData.Cells[0,i] := FldInfo.Owner.TypeName - else FGridData.Cells[0,i] := ''; - FGridData.Cells[4,i] := FieldLocationNames[FldInfo.FieldVisibility]; + 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,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] := ''; + + 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; diff --git a/ide/packages/idedebugger/debugger.pp b/ide/packages/idedebugger/debugger.pp index d92eb287bf..a9b465287e 100644 --- a/ide/packages/idedebugger/debugger.pp +++ b/ide/packages/idedebugger/debugger.pp @@ -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 diff --git a/ide/packages/idedebugger/idedebugger.lpk b/ide/packages/idedebugger/idedebugger.lpk index 3313c4218b..5dbd5b86bf 100644 --- a/ide/packages/idedebugger/idedebugger.lpk +++ b/ide/packages/idedebugger/idedebugger.lpk @@ -54,7 +54,11 @@ - + + + + + diff --git a/ide/packages/idedebugger/idedebuggerpackage.pas b/ide/packages/idedebugger/idedebuggerpackage.pas index b2ddc5d509..6dbe8351c9 100644 --- a/ide/packages/idedebugger/idedebuggerpackage.pas +++ b/ide/packages/idedebugger/idedebuggerpackage.pas @@ -10,7 +10,7 @@ interface uses IdeDebuggerBase, Debugger, ProcessDebugger, ProcessList, DebuggerTreeView, IdeDebuggerUtils, IdeDebuggerWatchResult, IdeDebuggerWatchResPrinter, - LazarusPackageIntf; + IdeDebuggerWatchResUtils, LazarusPackageIntf; implementation diff --git a/ide/packages/idedebugger/idedebuggerwatchresprinter.pas b/ide/packages/idedebugger/idedebuggerwatchresprinter.pas index 4022172146..b40df75cb1 100644 --- a/ide/packages/idedebugger/idedebuggerwatchresprinter.pas +++ b/ide/packages/idedebugger/idedebuggerwatchresprinter.pas @@ -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; diff --git a/ide/packages/idedebugger/idedebuggerwatchresult.pas b/ide/packages/idedebugger/idedebuggerwatchresult.pas index 68cf3f5964..f103d07468 100644 --- a/ide/packages/idedebugger/idedebuggerwatchresult.pas +++ b/ide/packages/idedebugger/idedebuggerwatchresult.pas @@ -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) + private + function GetClassID: TWatchResultDataClassID; override; + end; + + { TWatchResultDataProc } + + TWatchResultDataProc = class(specialize TGenericWatchResultDataProc) + private + function GetClassID: TWatchResultDataClassID; override; + end; + + { TWatchResultDataFuncRef } + + TWatchResultDataFuncRef = class(specialize TGenericWatchResultDataProc) + private + function GetClassID: TWatchResultDataClassID; override; + end; + + { TWatchResultDataProcRef } + + TWatchResultDataProcRef = class(specialize TGenericWatchResultDataProc) + private + function GetClassID: TWatchResultDataClassID; override; + end; + + + + { TWatchResultDataError } TWatchResultDataError = class(specialize TGenericWatchResultData) @@ -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( diff --git a/ide/packages/idedebugger/idedebuggerwatchresutils.pas b/ide/packages/idedebugger/idedebuggerwatchresutils.pas new file mode 100644 index 0000000000..1ab9df70b7 --- /dev/null +++ b/ide/packages/idedebugger/idedebuggerwatchresutils.pas @@ -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. +