paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-22 14:40:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

FpDebugger: Show classname for functions in stack.

Browse Source 
git-svn-id: trunk@64022 -
This commit is contained in:
martin 2020-10-15 18:38:20 +00:00
parent 569ea0aeb7
commit e2c618e262
3 changed files with 47 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
components/fpdebug/fpdbgclasses.pp
View File

@ -105,6 +105,7 @@ type
function GetProcSymbol: TFpSymbol;
function GetLine: integer;
function GetSourceFile: string;
function GetSrcClassName: string;
public
constructor create(AThread: TDbgThread; AnIndex: integer; AFrameAddress, AnAddress: TDBGPtr);
destructor Destroy; override;
@ -113,6 +114,7 @@ type
property FrameAdress: TDBGPtr read FFrameAdress;
property SourceFile: string read GetSourceFile;
property FunctionName: string read GetFunctionName;
property SrcClassName: string read GetSrcClassName;
property Line: integer read GetLine;
property RegisterValueList: TDbgRegisterValueList read FRegisterValueList;
property ProcSymbol: TFpSymbol read GetProcSymbol;
@ -1201,6 +1203,21 @@ begin
result := '';
end;
function TDbgCallstackEntry.GetSrcClassName: string;
var
Symbol: TFpSymbol;
begin
result := '';
Symbol := GetProcSymbol;
if assigned(Symbol) then begin
Symbol := Symbol.Parent;
if assigned(Symbol) then begin
result := Symbol.Name;
Symbol.ReleaseReference;
end;
end;
end;
constructor TDbgCallstackEntry.create(AThread: TDbgThread; AnIndex: integer; AFrameAddress, AnAddress: TDBGPtr);
begin
FThread := AThread;

21
components/fpdebug/fpdbgdwarf.pas
View File

@ -952,6 +952,7 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
function GetFlags: TDbgSymbolFlags; override;
procedure TypeInfoNeeded; override;
function GetParent: TFpSymbol; override;
function GetColumn: Cardinal; override;
function GetFile: String; override;
// function GetFlags: TDbgSymbolFlags; override;
@ -5735,6 +5736,26 @@ begin
t.ReleaseReference;
end;
function TFpSymbolDwarfDataProc.GetParent: TFpSymbol;
var
InfoEntry: TDwarfInformationEntry;
tg: Cardinal;
c: TDbgDwarfSymbolBaseClass;
begin
// special: search "self"
// Todo nested procs
Result := nil;
InfoEntry := InformationEntry.Clone;
InfoEntry.GoParent;
tg := InfoEntry.AbbrevTag;
if (tg = DW_TAG_class_type) or (tg = DW_TAG_structure_type) then begin
c := InfoEntry.CompUnit.DwarfSymbolClassMap.GetDwarfSymbolClass(tg);
if c <> nil then
Result := c.Create('', InfoEntry);
end;
InfoEntry.ReleaseReference;
end;
var
ThisNameInfo, SelfNameInfo: TNameSearchInfo;
function TFpSymbolDwarfDataProc.GetSelfParameter(AnAddress: TDbgPtr): TFpValueDwarf;

13
components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas
View File

@ -1151,6 +1151,7 @@ end;
procedure TFpThreadWorkerCallEntry.UpdateCallstackEntry_DecRef(Data: PtrInt);
var
dbg: TFpDebugDebugger;
c: String;
begin
assert(system.ThreadID = classes.MainThreadID, 'TFpThreadWorkerCallEntry.UpdateCallstackEntry_DecRef: system.ThreadID = classes.MainThreadID');
@ -1163,10 +1164,14 @@ begin
if FCallstackEntry.Validity = ddsRequested then begin
if FDbgCallStack = nil then
FCallstackEntry.Validity := ddsInvalid
else
else begin
c := FDbgCallStack.SrcClassName;
if c <> '' then
c := c + '.';
FCallstackEntry.Init(FDbgCallStack.AnAddress, nil,
FDbgCallStack.FunctionName + FParamAsString,
c + FDbgCallStack.FunctionName + FParamAsString,
FDbgCallStack.SourceFile, '', FDbgCallStack.Line, ddsValid);
end;
end;
if FCallstack <> nil then
@ -4604,8 +4609,8 @@ begin
result.SrcFullName := sym.FileName;
symproc := sym;
while not (symproc.kind in [skProcedure, skFunction]) do
symproc := symproc.Parent;
//while not (symproc.kind in [skProcedure, skFunction]) do
// symproc := symproc.Parent;
if assigned(symproc) then
result.FuncName:=symproc.Name;