diff --git a/components/fpdebug/fpdbgdwarf.pas b/components/fpdebug/fpdbgdwarf.pas index c3e50db5b3..d8c54d3e57 100644 --- a/components/fpdebug/fpdbgdwarf.pas +++ b/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; - InfoEntryInheritance.ReleaseReference; - Result := True; - exit; + break; 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; diff --git a/components/fpdebug/fpdbgdwarffreepascal.pas b/components/fpdebug/fpdbgdwarffreepascal.pas index dfae3244a2..c308d72c0a 100644 --- a/components/fpdebug/fpdbgdwarffreepascal.pas +++ b/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; diff --git a/components/lazdebuggers/lazdebuggerfp/test/testwatches.pas b/components/lazdebuggers/lazdebuggerfp/test/testwatches.pas index d74c75d1a2..3626b28f6b 100644 --- a/components/lazdebuggers/lazdebuggerfp/test/testwatches.pas +++ b/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; diff --git a/components/lazdebuggers/lazdebugtestbase/sources.res b/components/lazdebuggers/lazdebugtestbase/sources.res index f81dd919b9..4f276fca32 100644 Binary files a/components/lazdebuggers/lazdebugtestbase/sources.res and b/components/lazdebuggers/lazdebugtestbase/sources.res differ diff --git a/components/lazdebuggers/lazdebugtestbase/testapps/WatchesValuePrg.pas b/components/lazdebuggers/lazdebugtestbase/testapps/WatchesValuePrg.pas index 84802d0790..b44b86b617 100644 --- a/components/lazdebuggers/lazdebugtestbase/testapps/WatchesValuePrg.pas +++ b/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.