From 340f6f15027b8293694f9175bd65a204a83d5a9f Mon Sep 17 00:00:00 2001 From: Martin Date: Tue, 30 Nov 2021 15:50:52 +0100 Subject: [PATCH] FpDebug: Show "class var" if in current context (no class/instance-name prefix). (cherry picked from commit d8188bb7808eeb95760c78be932ace0303a4f929) --- components/fpdebug/fpdbgdwarf.pas | 34 +++++++-- components/fpdebug/fpdbgdwarffreepascal.pas | 72 ++++++++++++++++++ .../lazdebuggerfp/test/testwatches.pas | 52 ++++++++++++- .../lazdebuggers/lazdebugtestbase/sources.res | Bin 86752 -> 106360 bytes .../testapps/WatchesValuePrg.pas | 29 ++++++- 5 files changed, 176 insertions(+), 11 deletions(-) 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 f81dd919b90bd38ecc0a5b14a1ac4984346d2c12..4f276fca3285f6e9338675cabb768152a7f89c35 100644 GIT binary patch delta 19119 zcmchf-;X0#mB%v?+3Yq9V%hwHpyh@gCOyK0t}451&ukF>DS;BDCo@SbM$yRAUHyZ2 z>>k^lVS=((AS50@;=uy`0>lF#kotiKqKJLjx7F^$?)xs{ZME;KeaP-P->Pr9s_gRE zZVx?b>G=58J)e8-uXAqQp8xpy6aVw!U;OrKm!A0CuOEA?Ir;8qpFaEMrGLBdiSJxG z?)Q%Sff*beOzdAhKWSh7jeWN}G;el$HwJfu_Gy3b>;3UnbKD;Xhr#gL#jOKTjgJR? zllXr7%2gx9q7rw4!{h$NEn|kk=(IOBS6|LlC$$)=#T>Fb4&5 zSTIKgb6harDwuZ)rk67JjmVMaD_=4F!Po@-!Rg_VIP>s$G!BL%Gai_|Zm%aEH21sX zy(1I6+wEQ4g4+{5cU*T=Bkma{sE?eQPk>zotfl z{^)cVnEQb_>b@J8@sa#KI0??af90)DTKWEFtABde@y*?Vlo}s(`^GK#Mr@u2BlGfC z&3&n8bo^ehuieVR=4G?3pN(mKTe@Iprw|Da1($+Hp-7=b!I#bmpD$CWP^eOeQaPk@LMq$sImB{^<@ix;4yhbcIizw(<&erDl|w3rR8ES@C6((G zY}kC4ST3FAlFB8OODdOCE~#8nxukMQ<&w%Jl}jpDsO+>0Jz{xumPaa&R3523QhB8E zNac~rBb7%gk5nG1tVb-5SYFCmMN$<>RU}oBR7Fx1NmV3OkyJ%e6-iZ8DyxIHNUS2U zili!%s+giGk*Y+h5~)h0Dv_#0suHP6q$*irm55cMvr42Yk*Y+h5~)flDxXw7seDrT zr1DASgUU+tePa2<@=4{B$|sdiDxXw7seDrTDXKE5%A_ijs_b$8mx)!Tv&y6@ld4Rr zGO5a>DwC>Asxqm{q$;PVDj}83{|d1x#H!F)6;f45RUuV{R25QHNL3+Kg;W(%RY+Bd zsBEv2!m83)RZ>++RV7uGR8>+{NmV6Pl~h$yRY_GPRaK}gR^KYIs&rO0MO7nJjZ`&K z)ksw%RgF|NQq@RRBUO!5wnnTPv1)WyjZ`&K)lyV-Qq@USCsmzPbyC$yRVP(lsWAWR z#HtgkPO3Vo>ZGcZs!pnUimE}X2B{jPYLKcys)i+2gIEnZt3j#;sT!nekg7qd2B{jP zYNV)|q-v6?2`ZicO=2~P)g)DuR83MfN!27(lT=MoHA&SZRg+ZB6jf`7^S?!`7M;~1 zRf|+DQng6cB2|l2EmE~e)go1kR4r1qTHJqIDXcb~)h1P&RBckVN!2D*n^bL5wMo?` zRhv}ph|2cb#A*|(O=q=JR2@=vNYx=#hg2O>bx74ARfkj^Qgwu?g8APeR)@~&kg7wf z4yihAjj$&FUjDJwz_DmF6x2A=aTzoo42DJm$~(tnGYZDWZ1)0Oe zMQKGDe~29+Xu}|A!ystGAZWuNXu}}*+If()We~Jw5Y*ogv|$kHYEUzfD1`caUP#IfLAfC)Hw5K|pxh9&Lm((N1jUA+*bo#Og7yal?GFgr9}qBjA;rT) zKOyFYKq|z%(0Caq_){lTl1}j4Wt`ya;(^ZdRZw#f)CmyO2@uo?5Y!0})CmyO2@uo? z5Y!0})CmyO2@uo?5Y!3&o3eTD=%|D$c7lF_6CjWZPJo6~i2I=-72~HzBAuA*eGU#Lm=Da3%y&!I@?CKhh|CM=WGf(2xpQ6f~ql76lEdkVQd5 zDr8a6kZPJmsamoqng5W8g)9mhIty78G}^}yNQEp48d4#Pf`(McqM#uavM6YT%7!(j zoP{h(3m}Vvz%E1<1r2?LED9P@A&Y{BRLG*BA(h9qOp`a{iRnu$m&Qe3K!l4I2 zy$M0NA*eSYC^rQ4W(D(4!J*Qj2SLFh=+J|p;1G1^K~Q%>(4hxGI~hXkP5p$S2Z2-= zdeC^<|B#4I4Sc2NnS3i zTbZjjf-%A+-3kT=;oL3aj7~OO*&`60NFf9#$wDO*@=}Gcc_$0`C?xSqq9*J~C{&H? zl~F3(lV}g?N3yC43OV8OarQyw$>*Lm=43e73-<*pjf%4?u_17o=^!z8EYwH>8SWb}(CKelm{%G=>k3T>8m)&P3f4ct5 zH^R|8?+AM4bXbRdPC*>=#t2s?-`)D#j|u9v$p^1}_S4`@F`oVC_4hx0dD^<0uRhRr zpx{f1rb_U5XY$(7Gmks&6?kKlsj< za$dd4AJuvGWN^A=V^0WtSZU(;e#UomPVnPCF<(me&p2jZV8iyuVkG1D_|#h)Hv7(? zTozMZ`OZuYs^f-us}NhgxFzo^w9u=A{o{iNH-pi*E(83kl-rYoY5m3+domQwJw2($ z$UW)q?;rQ&82;|*XpB?#JAv7gqwT}+6x(RDdlfSU05Z4-BY6#?Q)j6P3MsaYCR}4B5c;uP&RBq&h!oz$%3y1#N1lc{ij??md zChx*lg|hQT*Yus54$-CiG7n3ZPQRD~W>*^a0_GRz^x|5bxI2*QY%t6rTL}zx;VtBf z9( z*NZ9CRoa2)T)%7>7)oX3jSMWUXca0u4J~H}yi``%6jfzDm3`RSH;3wVjfRD76KMA4 zjk|JXg;manT#ix4f-L4`#Ns2EE-;VrwvQkCdXHp&Mvh!+ObI|xas-M zmPn-jX!^u1%Cg03baU{WtNg(OHstGJE);i(ogM`|(kU-ZnVUJSp8v8XQOa}9Zn3ib zt-5@zoowld%#1G^t;A8n75B@Zsatk!a*aRFNe;UuOoNtghs3`d*;1w%-D*?C;v6i~ zDe>;etZwP%tlS!#S$?9`c#}CGdnU{SGfhGK|43*4;;hjwI&7TZEzI`LIrGDbZ9JNDjQH8IL6X!t1)_=E#!qmo!Au=0y#mxfSC`yYMx~hLY@Q z_$BR-JUh`2%NH?^cCxEodMLGMS%F#n#%KN_EEP&>o@mIL?U4L)sn_crvDcZShp6ENe zV7Tq=Bzz~HH>$D_0kz0Ma8I`|agdsNi|9rh4US7{P zB-?D*oVh(?_m}qCt*}LM*-u+md^@+B#A3Ke%(a*{Xt9~(Y$3P8YwLPdF1*pc(5Bo4 z)1TG6IWzulg*U0yCT=*_7TT1nWvkmvjuhCx6<#=2o8cwbg*N4)+WBm%{afKhQ&+D~ zTM zGyI>38mCn+3=C)@KRB40$i$`Gn!`B2Mt9ie^gwxb88;@{l5b9ec; z(&*;O>=Kw;XIrjs=WOb%HGgBztu?W|rm_oGncT+p&@_=^tX*gRuAN&YwlO<@<0NXd zOG{U!R*glA#-jb0)lT>1<@;e)N_wJ5G2) zlP;kbufuPvasr`m!eSeV>)=`Q(FJd)6VJThCa;%A-%2j?lGgl#e}3$-UHnfj|NBE{ z>oP9b+`j#mE}zbKg7>3+%iMl#_qK^%8#(^u*FP~H%XshOkVH-}qUYTF=l+k+Ntxtx zuPn0XxvrJDL3I zCtoN=vXq$jU~Dt};78L3GcD9$EY(OnNUd0Wp~MdvlT@coQakx5@npv4D}(;wtW9cR zlOHlRsZQIZR&DzHkgeHiL$`rzzyosvHHWK`y7&QlkD^|Px_UD$fD7|){cAx-(V zvl~e5?a95LKKu9jU3%PzrZihYNh;94(8c17Kh<^P3Z!@vS}O2oEAXWP&Dl^vl)RBZ zif1Y)&sI>D3bNY=E0E%u3M#V|RHOpUra*wSs*WanOn@ts_kaJ~1+YLQ1zcwU07R348WpozB-8wm1sId`X0nslXHJv#W+9V&Xsff$X?hZq#f1;ER()g&vrD9- z0h9ctCzFPzK(kP`-3SR&Z*65wWprpUvzfna5e;Q-WG)Q~4GOQu002;vff^OFy3sKT lvyb2wewR950i2bi0TGi&@DP`(gaHtjz;pozx2<6T%RLPWODq5Y 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.