FpDebugger: Show classname for functions in stack.

git-svn-id: trunk@64022 -

components/fpdebug/fpdbgclasses.pp

@@ -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;

components/fpdebug/fpdbgdwarf.pas

@@ -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;

components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas

@@ -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
+    //while not (symproc.kind in [skProcedure, skFunction]) do
-      symproc := symproc.Parent;
+    //  symproc := symproc.Parent;
 
     if assigned(symproc) then
       result.FuncName:=symproc.Name;