FpDebug: Show "class var" if in current context (no class/instance-name prefix).

(cherry picked from commit d8188bb780)

components/fpdebug/fpdbgdwarf.pas

@@ -123,10 +123,13 @@ type
     function FindExportedSymbolInUnits(const AName: String; const ANameInfo: TNameSearchInfo;
       SkipCompUnit: TDwarfCompilationUnit; out ADbgValue: TFpValue; const OnlyUnitNameLower: String = ''): Boolean;
     function FindSymbolInStructure(const AName: String; const ANameInfo: TNameSearchInfo;
+      InfoEntry: TDwarfInformationEntry; out ADbgValue: TFpValue): Boolean; virtual;
+    function FindSymbolInStructureRecursive(const AName: String; const ANameInfo: TNameSearchInfo;
       InfoEntry: TDwarfInformationEntry; out ADbgValue: TFpValue): Boolean; inline;
     // FindLocalSymbol: for the subroutine itself
     function FindLocalSymbol(const AName: String; const ANameInfo: TNameSearchInfo;
       InfoEntry: TDwarfInformationEntry; out ADbgValue: TFpValue): Boolean; virtual;
+    procedure Init; virtual;
   public
     constructor Create(ALocationContext: TFpDbgLocationContext; ASymbol: TFpSymbol; ADwarf: TFpDwarfInfo);
     destructor Destroy; override;
@@ -1474,22 +1477,34 @@ end;
 function TFpDwarfInfoSymbolScope.FindSymbolInStructure(const AName: String;
   const ANameInfo: TNameSearchInfo; InfoEntry: TDwarfInformationEntry; out
   ADbgValue: TFpValue): Boolean;
+begin
+  ADbgValue := nil;
+  Result := False;
+end;
+
+function TFpDwarfInfoSymbolScope.FindSymbolInStructureRecursive(const AName: String;
+  const ANameInfo: TNameSearchInfo; InfoEntry: TDwarfInformationEntry; out
+  ADbgValue: TFpValue): Boolean;
 var
   InfoEntryInheritance: TDwarfInformationEntry;
   FwdInfoPtr: Pointer;
   FwdCompUint: TDwarfCompilationUnit;
   SelfParam: TFpValue;
+  StartScope: Integer;
 begin
   Result := False;
   ADbgValue := nil;
   InfoEntry.AddReference;
+  InfoEntryInheritance := nil;
 
   while True do begin
     if not InfoEntry.IsAddressInStartScope(FAddress) then
       break;
 
+    InfoEntryInheritance.ReleaseReference;
     InfoEntryInheritance := InfoEntry.FindChildByTag(DW_TAG_inheritance);
 
+    StartScope := InfoEntry.ScopeIndex;
     if InfoEntry.GoNamedChildEx(ANameInfo) then begin
       if InfoEntry.IsAddressInStartScope(FAddress) then begin
         SelfParam := GetSelfParameter;
@@ -1501,12 +1516,13 @@ begin
         if ADbgValue = nil then begin // Todo: abort the searh /SetError
           ADbgValue := SymbolToValue(TFpSymbolDwarf.CreateSubClass(AName, InfoEntry));
         end;
-        InfoEntry.ReleaseReference;
+        break;
-        InfoEntryInheritance.ReleaseReference;
-        Result := True;
-        exit;
       end;
     end;
+    InfoEntry.ScopeIndex := StartScope;
+
+    if FindSymbolInStructure(AName, ANameInfo, InfoEntry, ADbgValue) then
+      break;
 
 
     if not( (InfoEntryInheritance <> nil) and
@@ -1515,10 +1531,10 @@ begin
       break;
     InfoEntry.ReleaseReference;
     InfoEntry := TDwarfInformationEntry.Create(FwdCompUint, FwdInfoPtr);
-    InfoEntryInheritance.ReleaseReference;
     DebugLn(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier  PARENT ', dbgs(InfoEntry, FwdCompUint) ]);
   end;
 
+  InfoEntryInheritance.ReleaseReference;
   InfoEntry.ReleaseReference;
   Result := ADbgValue <> nil;
 end;
@@ -1541,6 +1557,11 @@ begin
   Result := ADbgValue <> nil;
 end;
 
+procedure TFpDwarfInfoSymbolScope.Init;
+begin
+  //
+end;
+
 constructor TFpDwarfInfoSymbolScope.Create(
   ALocationContext: TFpDbgLocationContext; ASymbol: TFpSymbol;
   ADwarf: TFpDwarfInfo);
@@ -1552,6 +1573,7 @@ begin
   FAddress := LocationContext.Address; // for quick access
   if FSymbol <> nil then
     FSymbol.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FSymbol, 'Context to Symbol'){$ENDIF};
+  Init;
 end;
 
 destructor TFpDwarfInfoSymbolScope.Destroy;
@@ -1648,7 +1670,7 @@ begin
 
 
       if (tg = DW_TAG_class_type) or (tg = DW_TAG_structure_type) then begin
-        if FindSymbolInStructure(AName,NameInfo, InfoEntry, Result) then begin
+        if FindSymbolInStructureRecursive(AName,NameInfo, InfoEntry, Result) then begin
           exit; // TODO: check error
         end;
         //InfoEntry.ScopeIndex := StartScopeIdx;

components/fpdebug/fpdbgdwarffreepascal.pas

@@ -72,6 +72,8 @@ type
     class function ClassCanHandleCompUnit(ACU: TDwarfCompilationUnit): Boolean; override;
   public
     function GetDwarfSymbolClass(ATag: Cardinal): TDbgDwarfSymbolBaseClass; override;
+    function CreateScopeForSymbol(ALocationContext: TFpDbgLocationContext; ASymbol: TFpSymbol;
+      ADwarf: TFpDwarfInfo): TFpDbgSymbolScope; override;
     //class function CreateSymbolScope(AThreadId, AStackFrame: Integer; AnAddress: TDBGPtr; ASymbol: TFpSymbol;
     //  ADwarf: TFpDwarfInfo): TFpDbgSymbolScope; override;
     //class function CreateProcSymbol(ACompilationUnit: TDwarfCompilationUnit;
@@ -88,13 +90,25 @@ type
   private
     FOuterNestContext: TFpDbgSymbolScope;
     FOuterNotFound: Boolean;
+    FClassVarStaticPrefix: String;
   protected
     function FindLocalSymbol(const AName: String; const ANameInfo: TNameSearchInfo;
       InfoEntry: TDwarfInformationEntry; out ADbgValue: TFpValue): Boolean; override;
+    function FindSymbolInStructure(const AName: String;
+      const ANameInfo: TNameSearchInfo; InfoEntry: TDwarfInformationEntry; out
+      ADbgValue: TFpValue): Boolean; override;
+    procedure Init; override;
   public
     destructor Destroy; override;
   end;
 
+  { TFpDwarfFreePascalSymbolScopeDwarf3 }
+
+  TFpDwarfFreePascalSymbolScopeDwarf3 = class(TFpDwarfFreePascalSymbolScope)
+  protected
+    procedure Init; override;
+  end;
+
   {%EndRegion }
 
   {%Region * ***** Value & Types ***** *}
@@ -450,6 +464,13 @@ begin
   end;
 end;
 
+function TFpDwarfFreePascalSymbolClassMapDwarf3.CreateScopeForSymbol(
+  ALocationContext: TFpDbgLocationContext; ASymbol: TFpSymbol;
+  ADwarf: TFpDwarfInfo): TFpDbgSymbolScope;
+begin
+  Result := TFpDwarfFreePascalSymbolScopeDwarf3.Create(ALocationContext, ASymbol, ADwarf);
+end;
+
 type
 
   { TFpDbgDwarfSimpleLocationContext }
@@ -613,12 +634,63 @@ begin
   Result := True; // self, global was done by outer
 end;
 
+function TFpDwarfFreePascalSymbolScope.FindSymbolInStructure(
+  const AName: String; const ANameInfo: TNameSearchInfo;
+  InfoEntry: TDwarfInformationEntry; out ADbgValue: TFpValue): Boolean;
+var
+  CU: TDwarfCompilationUnit;
+  CurClassName, StaticName, FoundName: String;
+  MangledNameInfo: TNameSearchInfo;
+  FoundInfoEntry: TDwarfInformationEntry;
+  IsExternal: Boolean;
+begin
+  Result := inherited FindSymbolInStructure(AName, ANameInfo, InfoEntry, ADbgValue);
+  if Result then
+    exit;
+
+  CU := InfoEntry.CompUnit;
+  if (CU <> nil) and InfoEntry.HasValidScope and
+     InfoEntry.ReadName(CurClassName) and not InfoEntry.IsArtificial
+  then begin
+    StaticName := FClassVarStaticPrefix + LowerCase(CurClassName) + '_' + UpperCase(AName);
+    MangledNameInfo := NameInfoForSearch(StaticName);
+
+    if CU.KnownNameHashes^[MangledNameInfo.NameHash and KnownNameHashesBitMask] then begin
+      if FindExportedSymbolInUnit(CU, MangledNameInfo, FoundInfoEntry, IsExternal) then begin
+        if {(IsExternal) and} (FoundInfoEntry.ReadName(FoundName)) then begin
+          if FoundName = StaticName then begin // must be case-sensitive
+            ADbgValue := SymbolToValue(TFpSymbolDwarf.CreateSubClass(AName, FoundInfoEntry));
+            Result := True;
+          end;
+        end;
+        FoundInfoEntry.ReleaseReference;
+        if Result then
+          exit;
+      end;
+    end;
+  end;
+end;
+
+procedure TFpDwarfFreePascalSymbolScope.Init;
+begin
+  inherited Init;
+  FClassVarStaticPrefix := '_static_';
+end;
+
 destructor TFpDwarfFreePascalSymbolScope.Destroy;
 begin
   FOuterNestContext.ReleaseReference;
   inherited Destroy;
 end;
 
+{ TFpDwarfFreePascalSymbolScopeDwarf3 }
+
+procedure TFpDwarfFreePascalSymbolScopeDwarf3.Init;
+begin
+  inherited Init;
+  FClassVarStaticPrefix := '$_static_';
+end;
+
 { TFpSymbolDwarfV2FreePascalTypeStructure }
 
 function TFpSymbolDwarfV2FreePascalTypeStructure.IsShortString: Boolean;

components/lazdebuggers/lazdebuggerfp/test/testwatches.pas

@@ -18,7 +18,7 @@ type
     FEvalDone: Boolean;
     procedure DoEvalDone(Sender: TObject; ASuccess: Boolean;
       ResultText: String; ResultDBGType: TDBGType);
-    procedure RunToPause(var ABrk: TDBGBreakPoint);
+    procedure RunToPause(var ABrk: TDBGBreakPoint; ADisableBreak: Boolean = True);
   published
     procedure TestWatchesScope;
     procedure TestWatchesValue;
@@ -37,11 +37,13 @@ var
   ControlTestWatchAddressOf, ControlTestWatchTypeCast, ControlTestModify,
   ControlTestExpression, ControlTestErrors: Pointer;
 
-procedure TTestWatches.RunToPause(var ABrk: TDBGBreakPoint);
+procedure TTestWatches.RunToPause(var ABrk: TDBGBreakPoint;
+  ADisableBreak: Boolean);
 begin
   Debugger.RunToNextPause(dcRun);
   AssertDebuggerState(dsPause);
-  ABrk.Enabled := False;
+  if ADisableBreak then
+    ABrk.Enabled := False;
 end;
 
 procedure TTestWatches.DoEvalDone(Sender: TObject; ASuccess: Boolean;
@@ -1123,6 +1125,12 @@ for i := StartIdx to t.Count-1 do
 for i := StartIdxClassConst to t.Count-1 do
   t.Tests[i].SkipIf(ALoc in [tlClassConst]);
 
+
+
+    // Trigger a search through everything
+    t.Add('NotExistingFooBar123_X', weInteger(0))^.AddFlag(ehExpectError);
+
+
   end;
 
 var
@@ -1130,7 +1138,7 @@ var
   t: TWatchExpectationList;
   Src: TCommonSource;
   BrkPrg, BrkFooBegin, BrkFoo, BrkFooVar, BrkFooVarBegin,
-    BrkFooConstRef: TDBGBreakPoint;
+    BrkFooConstRef, BrkMethFoo, BrkBaseMethFoo: TDBGBreakPoint;
   c, i: Integer;
 begin
   if SkipTest then exit;
@@ -1158,6 +1166,9 @@ begin
     BrkFooVarBegin := Debugger.SetBreakPoint(Src, 'FooVarBegin');
     BrkFooVar      := Debugger.SetBreakPoint(Src, 'FooVar');
     BrkFooConstRef := Debugger.SetBreakPoint(Src, 'FooConstRef');
+    BrkMethFoo     := Debugger.SetBreakPoint(Src, 'MethFoo');  // call with TMyClass
+    BrkBaseMethFoo := Debugger.SetBreakPoint(Src, 'BaseMethFoo'); // call with TMyClass
+
     AssertDebuggerNotInErrorState;
 
     (* ************ Nested Functions ************* *)
@@ -1358,6 +1369,39 @@ if Compiler.Version < 030300 then
     t.CheckResults;
 
 
+    RunToPause(BrkBaseMethFoo, False);
+    t.Clear;
+    t.Add('BaseMethFoo of TMyClass1 - ClassBaseVar1', 'ClassBaseVar1', weInteger(118));
+//    t.Add('BaseMethFoo of TMyClass1 - ClassVar1', 'ClassVar1', weInteger(119));
+    // Trigger a search through everything
+    t.Add('BaseMethFoo of NotExistingFooBar123_X', weInteger(0))^.AddFlag(ehExpectError);
+    //AddWatches(t, 'foo const ref args', 'argconstref', 001, 'B', tlParam);
+    t.EvaluateWatches;
+    t.CheckResults;
+
+
+    RunToPause(BrkMethFoo);
+    t.Clear;
+    t.Add('MethFoo of TMyClass1 - ClassBaseVar1', 'ClassBaseVar1', weInteger(118));
+    t.Add('MethFoo of TMyClass1 - ClassVar1', 'ClassVar1', weInteger(119));
+    // Trigger a search through everything
+    t.Add('MethFoo of TMyClass1 - NotExistingFooBar123_X', weInteger(0))^.AddFlag(ehExpectError);
+    //AddWatches(t, 'foo const ref args', 'argconstref', 001, 'B', tlParam);
+    t.EvaluateWatches;
+    t.CheckResults;
+
+
+    RunToPause(BrkBaseMethFoo);
+    t.Clear;
+    t.Add('BaseMethFoo of TMyBaseClass - ClassBaseVar1', 'ClassBaseVar1', weInteger(118));
+//    t.Add('BaseMethFoo of TMyBaseClass - ClassVar1', 'ClassVar1', weInteger(119));
+    // Trigger a search through everything
+    t.Add('BaseMethFoo of TMyBaseClass - NotExistingFooBar123_X', weInteger(0))^.AddFlag(ehExpectError);
+    //AddWatches(t, 'foo const ref args', 'argconstref', 001, 'B', tlParam);
+    t.EvaluateWatches;
+    t.CheckResults;
+
+
   finally
     Debugger.RunToNextPause(dcStop);
     t.Free;

components/lazdebuggers/lazdebugtestbase/testapps/WatchesValuePrg.pas

@@ -13,6 +13,7 @@ program WatchesValuePrg;
 {$hints off}
 {$notes off}
 {$warnings off}
+{$inline off}
 
 uses sysutils, Classes;
 
@@ -68,7 +69,7 @@ type
 
 
 var
-  BreakDummy: PtrUInt;
+  BreakDummy, BreakDummy2: PtrUInt;
   PByteDummy: PByte;
   p: Pointer;
   pw: PWord; // ensure we have the type
@@ -349,10 +350,13 @@ type
     TEST_PREPOCESS(WatchesValuePrgIdent.inc, pre__=cl_v_, _OP_=:, (=;//, _O2_=:, _EQ_=, _BLOCK_=TestVar )
   public
     function SomeMeth1(SomeValue: Integer): Boolean;
+    procedure BaseMethFoo;
   public
     (* LOCATION: field in baseclass *)
     // mbcByte: Byte;
     TEST_PREPOCESS(WatchesValuePrgIdent.inc, pre__=mbc, _OP_=:, (=;//, _O2_=:, _EQ_=, _BLOCK_=TestVar )
+  public class var
+    ClassBaseVar1: integer;
   end;
   PMyBaseClass = ^TMyBaseClass;
 
@@ -367,6 +371,9 @@ type
 
     function SomeFuncIntRes(): Integer;
     function SomeFuncIntResAdd(a: integer): Integer;
+    procedure MethFoo;
+  public class var
+    ClassVar1: integer;
   end;
   PMyClass = ^TMyClass;
 
@@ -479,6 +486,18 @@ begin end;
 function TMyBaseClass.SomeMeth1(SomeValue: Integer): Boolean;
 begin result := SomeValue = 0; end;
 
+procedure TMyBaseClass.BaseMethFoo;
+begin
+  BreakDummy:= 112; // TEST_BREAKPOINT=BaseMethFoo
+  BreakDummy2 := ClassBaseVar1;
+end;
+
+procedure TMyClass.MethFoo;
+begin
+  BreakDummy:= 113; // TEST_BREAKPOINT=MethFoo
+  BreakDummy2 := ClassVar1;
+end;
+
 procedure Foo(
 (* LOCATION: param *)
   TEST_PREPOCESS(WatchesValuePrgIdent.inc, pre__=arg, _OP_=:, (=;//, _O2_=:, _EQ_= , _BLOCK_=TestArg)
@@ -969,5 +988,13 @@ begin
     0
   );
 
+  TMyClass.ClassBaseVar1 := 118;
+  TMyClass.ClassVar1 := 119;
+
+  MyClass1.BaseMethFoo();
+  MyClass1.MethFoo();
+
+  MyClass2.BaseMethFoo();
+
 end.