From 2c9e5f2f4b7abab18548fb78f91da3de639976c7 Mon Sep 17 00:00:00 2001 From: Martin Date: Fri, 31 Jan 2025 00:59:20 +0100 Subject: [PATCH] FpDebug: Test LineInfo and GetLineAddresses with filenames with/without path or wrong path (also needed for generics) --- .../test/testapps/app_generic/app_gen.pas | 33 ++++ .../test/testapps/app_generic/incbar.inc | 99 ++++++++++ .../test/testapps/app_generic/incfoo.inc | 100 ++++++++++ .../test/testapps/app_generic/unit_gen1.pas | 114 +++++++++++ .../lazdebuggerfp/test/testbreakpoint.pas | 186 +++++++++++++++++- .../lazdebugtestbase/testcommonsources.pas | 31 ++- 6 files changed, 559 insertions(+), 4 deletions(-) create mode 100644 components/lazdebuggers/lazdebuggerfp/test/testapps/app_generic/app_gen.pas create mode 100644 components/lazdebuggers/lazdebuggerfp/test/testapps/app_generic/incbar.inc create mode 100644 components/lazdebuggers/lazdebuggerfp/test/testapps/app_generic/incfoo.inc create mode 100644 components/lazdebuggers/lazdebuggerfp/test/testapps/app_generic/unit_gen1.pas diff --git a/components/lazdebuggers/lazdebuggerfp/test/testapps/app_generic/app_gen.pas b/components/lazdebuggers/lazdebuggerfp/test/testapps/app_generic/app_gen.pas new file mode 100644 index 0000000000..d31f170306 --- /dev/null +++ b/components/lazdebuggers/lazdebuggerfp/test/testapps/app_generic/app_gen.pas @@ -0,0 +1,33 @@ +program app_gen; +{$mode objfpc} + +uses + unit_gen1; //, Unit2; + +//type +// TMyList = specialize TFPGList; + + procedure Test; + //var l1: TMyList; + // a: Integer; + begin + Log1; + specialize Log; + //specialize XLog; + //foo; + // + //l1 := TMyList.Create; + //l1.Add(1); + //a := l1.First; + //a := l1.Count; + + {$I bar/inc1.inc} + {$I foo/inc1.inc} + end; + + begin + Test; // TEST_BREAKPOINT=BrkMain + Test; + end. + +// Must end before line 90, or other units must be adapted diff --git a/components/lazdebuggers/lazdebuggerfp/test/testapps/app_generic/incbar.inc b/components/lazdebuggers/lazdebuggerfp/test/testapps/app_generic/incbar.inc new file mode 100644 index 0000000000..5ca80318ad --- /dev/null +++ b/components/lazdebuggers/lazdebuggerfp/test/testapps/app_generic/incbar.inc @@ -0,0 +1,99 @@ + +// Code starts at line 90 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + WriteLn(random(11)); // TEST_BREAKPOINT=BrkIncBar + + + + + + // LINE 98 in both inc files + WriteLn(random(11)); // TEST_BREAKPOINT=BrkIncBoth + diff --git a/components/lazdebuggers/lazdebuggerfp/test/testapps/app_generic/incfoo.inc b/components/lazdebuggers/lazdebuggerfp/test/testapps/app_generic/incfoo.inc new file mode 100644 index 0000000000..8cdb7dcb45 --- /dev/null +++ b/components/lazdebuggers/lazdebuggerfp/test/testapps/app_generic/incfoo.inc @@ -0,0 +1,100 @@ + +// Code starts at line 95 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + WriteLn(random(11)); // TEST_BREAKPOINT=BrkIncFoo +// LINE 98 in both inc files + WriteLn(random(11)); // TEST_BREAKPOINT=BrkIncBoth + + diff --git a/components/lazdebuggers/lazdebuggerfp/test/testapps/app_generic/unit_gen1.pas b/components/lazdebuggers/lazdebuggerfp/test/testapps/app_generic/unit_gen1.pas new file mode 100644 index 0000000000..c966b210a9 --- /dev/null +++ b/components/lazdebuggers/lazdebuggerfp/test/testapps/app_generic/unit_gen1.pas @@ -0,0 +1,114 @@ +unit unit_gen1; +{$mode objfpc} + +interface + +generic function Log: integer; overload; +function Log1: integer; overload; + +implementation + +// Code starts at line 100 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +// Must not have code before line 100 + + + +function Log1: integer; +begin + WriteLn('xxx'); // TEST_BREAKPOINT=BrkUnit1Log +end; + +generic function Log: integer; +begin + WriteLn('xxx'); // TEST_BREAKPOINT=BrkUnit1GenLog +end; + +end. diff --git a/components/lazdebuggers/lazdebuggerfp/test/testbreakpoint.pas b/components/lazdebuggers/lazdebuggerfp/test/testbreakpoint.pas index a496177fd8..e8a2fff85d 100644 --- a/components/lazdebuggers/lazdebuggerfp/test/testbreakpoint.pas +++ b/components/lazdebuggers/lazdebuggerfp/test/testbreakpoint.pas @@ -32,6 +32,9 @@ type { TTestBreakPoint } TTestBreakPoint = class(TDBGTestCase) + private + FLineInfoChanged: Boolean; + procedure DoLineInfoChanged(const ASender: TObject; const ASource: String); protected // Info/Methods used by tests based on TestBreakPointThreadPrg FThrPrgInfo: TBreakThreadPrgInfo; @@ -92,6 +95,9 @@ type continues. *) procedure TestBreakThreadsIgnoreOther; + + // + procedure TestLineInfo; end; implementation @@ -99,7 +105,7 @@ implementation var ControlTest, ControlTestGetAddressForLine, ControlTestBreak, ControlTestThreadNoSkip, ControlTestThreadMove1, ControlTestThreadMove2, ControlTestThreadHit, - ControlTestThreadIgnoreOther: Pointer; + ControlTestThreadIgnoreOther, ControlTestLineInfo: Pointer; procedure TTestBreakPoint.TestLocation(ATestName, ABrkName: String; ABreakHitCount: Integer); @@ -456,6 +462,11 @@ begin end; end; +procedure TTestBreakPoint.DoLineInfoChanged(const ASender: TObject; const ASource: String); +begin + FLineInfoChanged := True; +end; + procedure TTestBreakPoint.ThrPrgInitializeThreads(ATestName: String); var i, j: Integer; @@ -1124,6 +1135,178 @@ begin end; + dbg.Stop; + finally + Debugger.ClearDebuggerMonitors; + Debugger.FreeDebugger; + + AssertTestErrors; + end; +end; + +procedure TTestBreakPoint.TestLineInfo; +var + Ctrl: TDbgController; + + procedure GetLineInfo(ASource: string); + var + t: Integer; + begin + dbg.LineInfo.Request(ASource); + t := 1000; + FLineInfoChanged := False; + while (not FLineInfoChanged) and (t > 0) do begin + if dbg.LineInfo.IndexOf(ASource) >= 0 then break; + Application.ProcessMessages; + Sleep(10); + dec(t); + end; + TestTrue('Got line info '+ASource, t>0); + end; + + procedure TestHasLine(ASourceName: String; ALineNum: integer; AReverse: boolean = False); + var + Idx: Integer; + n: String; + ResLst: TDBGPtrArray; + FndLine: Integer; + FndFile, r: Boolean; + begin + Idx := dbg.LineInfo.IndexOf(ASourceName); + n := ASourceName+':'+IntToStr(ALineNum); + if AReverse then n := 'NOT - ' + n; + TestTrue('Has line (idx) '+n, dbg.LineInfo.HasAddress(Idx, ALineNum) xor AReverse); + TestTrue('Has line (name) '+n, dbg.LineInfo.HasAddress(ASourceName, ALineNum) xor AReverse); + + + (* Test if we could set a breakpoint / relies on how internal breakpoint code searches addresses *) + + r := Ctrl.CurrentProcess.DbgInfo.GetLineAddresses(ASourceName, + ALineNum, ResLst, fsNone); + TestTrue('Got Address) '+n, r xor AReverse); + if not AReverse then + TestEquals('Got ONE Address) '+n, 1, Length(ResLst)); + + end; + + procedure TestHasLine(ASrc, ABrkSrc: TCommonSource; ABrkName: String; AReverse: boolean = False); + begin + TestHasLine(ASrc.FullFileName, ABrkSrc.BreakPoints[ABrkName], AReverse); + end; + + procedure TestHasLine(ASrc: TCommonSource; ABrkName: String; AReverse: boolean = False); + begin + TestHasLine(ASrc.FullFileName, ASrc.BreakPoints[ABrkName], AReverse); + end; + +var + ExeName, BadPath: String; + SrcUnit1, SrcIncBar, SrcIncFoo: TCommonSource; + FpDbg: TFpDebugDebugger; +begin + if Compiler.Version < 030200 then exit; + if SkipTest then exit; + if not TestControlCanTest(ControlTestLineInfo) then exit; + + Src := GetCommonSourceFor(AppDir + 'app_generic' + PathDelim + 'app_gen.pas'); + Src.FileName := 'BreakLineTestPrg.pas'; + Src.Save(AppDir); + + SrcUnit1 := GetCommonSourceFor(AppDir + 'app_generic' + PathDelim + 'unit_gen1.pas'); + SrcUnit1.FileName := 'unit_gen1.pas'; + SrcUnit1.SaveTo(Src); + + SrcIncBar := GetCommonSourceFor(AppDir + 'app_generic' + PathDelim + 'incbar.inc'); + SrcIncBar.FileName := 'inc1.inc'; + SrcIncBar.SaveTo(Src, 'bar'); + + SrcIncFoo := GetCommonSourceFor(AppDir + 'app_generic' + PathDelim + 'incfoo.inc'); + SrcIncFoo.FileName := 'inc1.inc'; + SrcIncFoo.SaveTo(Src, 'foo'); + + TestCompile(Src, ExeName); + + BadPath := PathDelim + 'NoSuchDir' + PathDelim + '123xyzfoobar_123' + PathDelim; + + TestTrue('Start debugger', Debugger.StartDebugger(AppDir, ExeName)); + dbg := Debugger.LazDebugger; + dbg.LineInfo.OnChange := @DoLineInfoChanged; + FpDbg := dbg as TFpDebugDebugger; + Ctrl := FpDbg.DbgController; + + try + Debugger.SetBreakPoint(Src, 'BrkMain'); + AssertDebuggerNotInErrorState; + Debugger.RunToNextPause(dcRun); + AssertDebuggerState(dsPause, 'main init'); + + GetLineInfo(Src.FullFileName); + TestHasLine(Src, 'BrkMain'); + TestHasLine(Src, SrcUnit1, 'BrkUnit1Log', True); + TestHasLine(Src, SrcUnit1, 'BrkUnit1GenLog', True); + TestHasLine(Src, SrcIncBar, 'BrkIncBar', True); + + GetLineInfo(SrcUnit1.FullFileName); + TestHasLine(SrcUnit1, 'BrkUnit1Log'); + TestHasLine(SrcUnit1, 'BrkUnit1GenLog'); + TestHasLine(SrcUnit1, Src, 'BrkMain', True); + TestHasLine(SrcUnit1, SrcIncBar, 'BrkIncBar', True); + + GetLineInfo(SrcIncBar.FullFileName); + TestHasLine(SrcIncBar, 'BrkIncBar'); + TestHasLine(SrcIncBar, SrcIncFoo, 'BrkIncFoo', True); + TestHasLine(SrcIncBar, Src, 'BrkMain', True); + TestHasLine(SrcIncBar, SrcUnit1, 'BrkUnit1Log', True); + + GetLineInfo(SrcIncFoo.FullFileName); + TestHasLine(SrcIncFoo, 'BrkIncFoo'); + TestHasLine(SrcIncFoo, SrcIncBar, 'BrkIncBar', True); + TestHasLine(SrcIncFoo, Src, 'BrkMain', True); + TestHasLine(SrcIncFoo, SrcUnit1, 'BrkUnit1Log', True); + + // using wrong path in filename + GetLineInfo(BadPath+Src.FileName); + TestHasLine(BadPath+Src.FileName, Src.BreakPoints['BrkMain']); + TestHasLine(BadPath+Src.FileName, SrcUnit1.BreakPoints['BrkUnit1Log'], True); + TestHasLine(BadPath+Src.FileName, SrcUnit1.BreakPoints['BrkUnit1GenLog'], True); + TestHasLine(BadPath+Src.FileName, SrcIncBar.BreakPoints['BrkIncBar'], True); + + GetLineInfo(BadPath+SrcUnit1.FileName); + TestHasLine(BadPath+SrcUnit1.FileName, SrcUnit1.BreakPoints['BrkUnit1Log']); + TestHasLine(BadPath+SrcUnit1.FileName, SrcUnit1.BreakPoints['BrkUnit1GenLog']); + TestHasLine(BadPath+SrcUnit1.FileName, Src.BreakPoints['BrkMain'], True); + TestHasLine(BadPath+SrcUnit1.FileName, SrcIncBar.BreakPoints['BrkIncBar'], True); + + GetLineInfo(BadPath+SrcIncBar.FileName); + TestHasLine(BadPath+SrcIncBar.FileName, SrcIncBar.BreakPoints['BrkIncBoth']); // not able to tell which inc + TestHasLine(BadPath+SrcIncBar.FileName, Src.BreakPoints['BrkMain'], True); + TestHasLine(BadPath+SrcIncBar.FileName, SrcUnit1.BreakPoints['BrkUnit1Log'], True); + + + // using NO path in filename + GetLineInfo(Src.FileName); + TestHasLine(Src.FileName, Src.BreakPoints['BrkMain']); + TestHasLine(Src.FileName, SrcUnit1.BreakPoints['BrkUnit1Log'], True); + TestHasLine(Src.FileName, SrcUnit1.BreakPoints['BrkUnit1GenLog'], True); + TestHasLine(Src.FileName, SrcIncBar.BreakPoints['BrkIncBar'], True); + + GetLineInfo(SrcUnit1.FileName); + TestHasLine(SrcUnit1.FileName, SrcUnit1.BreakPoints['BrkUnit1Log']); + TestHasLine(SrcUnit1.FileName, SrcUnit1.BreakPoints['BrkUnit1GenLog']); + TestHasLine(SrcUnit1.FileName, Src.BreakPoints['BrkMain'], True); + TestHasLine(SrcUnit1.FileName, SrcIncBar.BreakPoints['BrkIncBar'], True); + + GetLineInfo(SrcIncBar.FileName); + TestHasLine(SrcIncBar.FileName, SrcIncBar.BreakPoints['BrkIncBoth']); // not able to tell which inc + //TestHasLine(SrcIncBar.FileName, SrcIncBar.BreakPoints['BrkIncBar']); + //TestHasLine(SrcIncBar.FileName, SrcIncFoo.BreakPoints['BrkIncFoo'], True); // not implemented + TestHasLine(SrcIncBar.FileName, Src.BreakPoints['BrkMain'], True); + TestHasLine(SrcIncBar.FileName, SrcUnit1.BreakPoints['BrkUnit1Log'], True); + + + + + dbg.Stop; finally Debugger.ClearDebuggerMonitors; @@ -1145,5 +1328,6 @@ initialization ControlTestThreadMove2 := TestControlRegisterTest('TTestBreakThreadMove2', ControlTest); ControlTestThreadHit := TestControlRegisterTest('TTestBreakThreadHit', ControlTest); ControlTestThreadIgnoreOther := TestControlRegisterTest('TTestBreakThreadIgnoreOther', ControlTest); + ControlTestLineInfo := TestControlRegisterTest('TestLineInfo', ControlTest); end. diff --git a/components/lazdebuggers/lazdebugtestbase/testcommonsources.pas b/components/lazdebuggers/lazdebugtestbase/testcommonsources.pas index 590155f6c8..e2ea8af105 100644 --- a/components/lazdebuggers/lazdebugtestbase/testcommonsources.pas +++ b/components/lazdebuggers/lazdebugtestbase/testcommonsources.pas @@ -30,8 +30,10 @@ type public constructor Create(AName: String); destructor Destroy; override; - procedure Save(BaseDir: String); - property FileName: String read FFileName; + procedure Save(BaseDir: String; SubDir: String = ''); + procedure SaveTo(AFolder: TCommonSource; SubDir: String=''); + procedure SaveTo(AFolder: String); + property FileName: String read FFileName write FFileName; property FullFileName: String read GetFullFileName; property Folder: String read FFolder; property OtherSrc[AName: String]: TCommonSource read GetOtherSrc; @@ -217,11 +219,12 @@ begin inherited Destroy; end; -procedure TCommonSource.Save(BaseDir: String); +procedure TCommonSource.Save(BaseDir: String; SubDir: String); var d: String; i: Integer; begin + if pos(PathDelim, FFileName) > 0 then exit; if FFolder <> '' then exit; d := AppendPathDelim(BaseDir) + ExtractFileNameOnly(FFileName) + '_' + IntToStr(Random(9999999))+'_'; @@ -231,11 +234,33 @@ begin CreateDirUTF8(d); CreateDirUTF8(AppendPathDelim(d)+'lib'); FFolder := d; + if SubDir <> '' then + FFolder := AppendPathDelim(FFolder) + SubDir; SaveToFolder(d); for i := 0 to Length(FOtherSources) - 1 do FOtherSources[i].SaveToFolder(d); end; +procedure TCommonSource.SaveTo(AFolder: TCommonSource; SubDir: String); +begin + if SubDir <> '' then + SaveTo(AppendPathDelim(AFolder.Folder) + SubDir) + else + SaveTo(AFolder.Folder); +end; + +procedure TCommonSource.SaveTo(AFolder: String); +var + i: Integer; +begin + FFolder := AFolder; + if not DirectoryExistsUTF8(FFolder) then + CreateDirUTF8(FFolder); + SaveToFolder(FFolder); + for i := 0 to Length(FOtherSources) - 1 do + FOtherSources[i].SaveToFolder(FFolder); +end; + initialization CommonSources := TStringList.Create;