FpDebug: Fix/Improve watches of Function/-ref

git-svn-id: trunk@61732 -

components/fpdebug/fpdbgdwarf.pas

@@ -919,6 +919,7 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
     procedure KindNeeded; override;
     procedure SizeNeeded; override;
     function GetFlags: TDbgSymbolFlags; override;
+    procedure TypeInfoNeeded; override;
 
     function GetColumn: Cardinal; override;
     function GetFile: String; override;
@@ -934,6 +935,22 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
     function GetSelfParameter(AnAddress: TDbgPtr = 0): TFpValueDwarf;
   end;
 
+  { TFpSymbolDwarfTypeProc }
+
+  TFpSymbolDwarfTypeProc = class(TFpSymbolDwarfType)
+  private
+    FDataSymbol: TFpSymbolDwarfDataProc;
+  protected
+    procedure ForwardToSymbolNeeded; override;
+    procedure CircleBackRefActiveChanged(ANewActive: Boolean); override;
+    procedure NameNeeded; override;
+    procedure KindNeeded; override;
+    procedure TypeInfoNeeded; override;
+  public
+    constructor Create(AName: String; AnInformationEntry: TDwarfInformationEntry;
+      ADataSymbol: TFpSymbolDwarfDataProc);
+  end;
+
   { TFpSymbolDwarfDataVariable }
 
   TFpSymbolDwarfDataVariable = class(TFpSymbolDwarfDataWithLocation)
@@ -1676,7 +1693,7 @@ end;
 procedure TFpValueDwarf.CircleBackRefActiveChanged(NewActive: Boolean);
 begin
   inherited CircleBackRefActiveChanged(NewActive);
-  if NewActive then;
+  //if NewActive then;
   if CircleBackRefsActive then begin
     if FValueSymbol <> nil then
       FValueSymbol.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FValueSymbol, 'TDbgDwarfSymbolValue'){$ENDIF};
@@ -3246,7 +3263,7 @@ begin
   Result := GetValueAddress(AValueObj, AnAddress);
   Result := Result and IsReadableLoc(AnAddress);
   if Result then begin
-    Result := TFpSymbolDwarfType(TypeInfo).GetDataAddress(AValueObj, AnAddress, ATargetType, 1);
+    Result := TFpSymbolDwarf(TypeInfo).GetDataAddress(AValueObj, AnAddress, ATargetType, 1);
     if not Result then SetLastError(TypeInfo.LastError);
   end;
 end;
@@ -5036,10 +5053,7 @@ end;
 
 procedure TFpSymbolDwarfDataProc.KindNeeded;
 begin
-  if TypeInfo <> nil then
+  SetKind(TypeInfo.Kind);
-    SetKind(skFunction)
-  else
-    SetKind(skProcedure);
 end;
 
 procedure TFpSymbolDwarfDataProc.SizeNeeded;
@@ -5056,6 +5070,15 @@ begin
     Result := Result + flg;
 end;
 
+procedure TFpSymbolDwarfDataProc.TypeInfoNeeded;
+var
+  t: TFpSymbolDwarfTypeProc;
+begin
+  t := TFpSymbolDwarfTypeProc.Create('', InformationEntry, Self); // returns with 1 circulor ref
+  SetTypeInfo(t); // TODO: avoid adding a reference, already got one....
+  t.ReleaseReference;
+end;
+
 function TFpSymbolDwarfDataProc.GetSelfParameter(AnAddress: TDbgPtr): TFpValueDwarf;
 const
   this1: string = 'THIS';
@@ -5099,6 +5122,57 @@ begin
   InfoEntry.ReleaseReference;
 end;
 
+{ TFpSymbolDwarfTypeProc }
+
+procedure TFpSymbolDwarfTypeProc.ForwardToSymbolNeeded;
+begin
+  SetForwardToSymbol(FDataSymbol); // Does *NOT* add reference
+end;
+
+procedure TFpSymbolDwarfTypeProc.CircleBackRefActiveChanged(ANewActive: Boolean
+  );
+begin
+  inherited CircleBackRefActiveChanged(ANewActive);
+  if (FDataSymbol = nil) then
+    exit;
+
+  if ANewActive then
+    FDataSymbol.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FDataSymbol, 'FDataSymbol'){$ENDIF}
+  else
+    FDataSymbol.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FDataSymbol, 'FDataSymbol'){$ENDIF};
+end;
+
+procedure TFpSymbolDwarfTypeProc.NameNeeded;
+begin
+  case Kind of
+    skFunction:  SetName('function');
+    skProcedure: SetName('procedure');
+    else         SetName('');
+  end;
+end;
+
+procedure TFpSymbolDwarfTypeProc.KindNeeded;
+begin
+  if TypeInfo <> nil then
+    SetKind(skFunction)
+  else
+    SetKind(skProcedure);
+end;
+
+procedure TFpSymbolDwarfTypeProc.TypeInfoNeeded;
+begin
+  SetTypeInfo(FDataSymbol.NestedTypeInfo);
+end;
+
+constructor TFpSymbolDwarfTypeProc.Create(AName: String;
+  AnInformationEntry: TDwarfInformationEntry;
+  ADataSymbol: TFpSymbolDwarfDataProc);
+begin
+  inherited Create(AName, AnInformationEntry);
+  MakePlainRefToCirclular;          // Done for the Caller // So we can set FDataSymbol without back-ref
+  FDataSymbol := ADataSymbol;
+end;
+
 { TFpSymbolDwarfDataVariable }
 
 function TFpSymbolDwarfDataVariable.GetValueAddress(AValueObj: TFpValueDwarf; out

components/fpdebug/fpdbginfo.pas

@@ -602,6 +602,8 @@ procedure TFpDbgCircularRefCountedObject.ReleaseCirclularReference{$IFDEF WITH_R
 var
   i: Integer;
 begin
+  if self = nil then
+    exit;
   Assert(FCircleRefCount > 0, 'ReleaseCirclularReference > 0');
   if CircleBackRefsActive then begin
     dec(FCircleRefCount);

components/fpdebug/fppascalbuilder.pas

@@ -100,9 +100,7 @@ begin
   Result := ADbgSymbol <> nil;
   if not Result then
     exit;
-  if (ADbgSymbol.SymbolType = stValue) and
+  if (ADbgSymbol.SymbolType = stValue) then begin
-     not((ADbgSymbol.Kind = skProcedure) or (ADbgSymbol.Kind = skFunction))
-  then begin
     ADbgSymbol := ADbgSymbol.TypeInfo;
     Result := ADbgSymbol <> nil;
     if not Result then
@@ -456,9 +454,7 @@ begin
   if not Result then
     exit;
   VarName := '';
-  if (ADbgSymbol.SymbolType = stValue) and
+  if (ADbgSymbol.SymbolType = stValue) then begin
-     not((ADbgSymbol.Kind = skProcedure) or (ADbgSymbol.Kind = skFunction))
-  then begin
     if tdfIncludeVarName in AFlags then
       VarName := ADbgSymbol.Name;
     ADbgSymbol := ADbgSymbol.TypeInfo;
@@ -673,27 +669,29 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
   var
     s: String;
     proc: TFpSymbolDwarf;
-    v: TDBGPtr;
     t: TFpSymbol;
     par: TFpValueDwarf;
+    v: TFpDbgMemLocation;
+    va: TDBGPtr;
   begin
     proc := nil;
-    v := AValue.DataAddress.Address;
+    v := AValue.DataAddress;
+    va := v.Address;
     if (ppvCreateDbgType in AFlags) then begin
       ADBGTypeInfo^ := TDBGType.Create(AValue.Kind, '');
       if AValue.Kind in [skFunctionRef, skProcedureRef] then
-        ADBGTypeInfo^.Value.AsPointer := Pointer(v);  // TODO: no cut off
+        ADBGTypeInfo^.Value.AsPointer := Pointer(va);  // TODO: no cut off
     end;
 
     // TODO: depending on verbosity: TypeName($0123456)
     if AValue.Kind in [skFunctionRef, skProcedureRef] then begin
-      if v = 0 then
+      if va = 0 then
         APrintedValue := 'nil'
       else
-        APrintedValue := '$'+IntToHex(v, AnAddressSize*2);
+        APrintedValue := '$'+IntToHex(va, AnAddressSize*2);
 
       t := AValue.TypeInfo;
-      proc := TFpSymbolDwarf(TDbgDwarfSymbolBase(t).CompilationUnit.Owner.FindSymbol(v));
+      proc := TFpSymbolDwarf(TDbgDwarfSymbolBase(t).CompilationUnit.Owner.FindSymbol(va));
       if proc <> nil then begin
         //t := proc;
         s := proc.Name;
@@ -715,6 +713,10 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
       GetTypeAsDeclaration(s, t);
     APrintedValue := APrintedValue + s;
 
+    if (AValue.Kind in [skFunction, skProcedure]) and IsReadableLoc(v) then begin
+      APrintedValue := APrintedValue + ' AT ' + '$'+IntToHex(va, AnAddressSize*2);
+    end;
+
     ReleaseRefAndNil(proc);
     Result := True;
   end;