paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-19 05:39:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

FpDebug: TestCase, more refactor internal breakpoints.

Browse Source 
git-svn-id: trunk@60161 -
This commit is contained in:
martin 2019-01-23 21:30:13 +00:00
parent 88aca89865
commit ceb99f5f2e
3 changed files with 128 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
components/lazdebuggers/lazdebuggerfp/test/testapps/BreakPointPrg.pas
View File

@ -1,6 +1,19 @@
program BreakPointPrg;
uses sysutils, Classes;
uses
{$IFDEF UNIX}
cthreads,
{$ENDIF}
sysutils, Classes;
type
{ TTestThread }
TTestThread = class(TThread)
procedure Execute; override;
end;
var
x, BreakDummy: Integer;
@ -22,6 +35,23 @@ end;
label
testasmlbl1, testasmlbl2;
{ TTestThread }
procedure TTestThread.Execute;
var
tt: Integer;
begin
tt := 1; // TEST_BREAKPOINT=Thread1
tt := 1; // TEST_BREAKPOINT=Thread2
tt := 1;
while true do begin
tt := 1;
tt := 1;
tt := 1;
tt := 1;
end;
end;
begin
x := 1;
x := 1; BreakDummy:= 1; // TEST_BREAKPOINT=PrgStep1
@ -59,11 +89,32 @@ testasmlbl2:
Foo2;
BreakDummy:= 1; // TEST_BREAKPOINT=PrgAfterFoo2
Foo2;
BreakDummy:= 1; // TEST_BREAKPOINT=PrgAfterFoo2B
BreakDummy:= 1; // TEST_BREAKPOINT=New1
BreakDummy:= 1; // TEST_BREAKPOINT=New2
BreakDummy:= 1;
// TODO; stepping over ignored breakpoint / actually that is stepping test
// edit line / move breakpoint
TTestThread.Create(False);
while true do begin
asm
nop
nop // TEST_BREAKPOINT=Main1
nop
nop
nop
nop
nop
nop // TEST_BREAKPOINT=Main2
nop
nop
nop
nop
nop
nop
end;
end;
end.

77
components/lazdebuggers/lazdebuggerfp/test/testbreakpoint.pas
View File

@ -8,7 +8,7 @@ uses
Classes, SysUtils, fpcunit, testutils, testregistry, TestBase, TestDbgControl,
TestDbgTestSuites, TTestDebuggerClasses, TestOutputLogger,
TTestWatchUtilities, TestCommonSources, TestDbgConfig, DbgIntfDebuggerBase,
DbgIntfBaseTypes, Forms;
DbgIntfBaseTypes, LazLoggerBase, Forms;
type
@ -35,6 +35,9 @@ var
Src: TCommonSource;
dbg: TDebuggerIntf;
ExeName: String;
loc: TDBGLocationRec;
b1, b2: TDBGBreakPoint;
i: Integer;
procedure TestLocation(ATestName, ABrkName: String; ABreakHitCount: Integer = 1);
var
@ -43,12 +46,11 @@ var
AssertDebuggerState(dsPause);
lc := dbg.GetLocation;
TestEquals(ATestName+' '+ABrkName+' Loc', Src.BreakPoints[ABrkName], lc.SrcLine);
TestEquals(ATestName+' '+ABrkName+' HitCnt', Debugger.BreakPointByName(ABrkName).HitCount, ABreakHitCount);
if ABreakHitCount >= 0 then
TestEquals(ATestName+' '+ABrkName+' HitCnt', Debugger.BreakPointByName(ABrkName).HitCount, ABreakHitCount);
end;
procedure TestHitCnt(ATestName, ABrkName: String; ABreakHitCount: Integer);
var
lc: TDBGLocationRec;
begin
TestEquals(ATestName+' '+ABrkName+' HitCnt', Debugger.BreakPointByName(ABrkName).HitCount, ABreakHitCount);
end;
@ -84,7 +86,8 @@ begin
Debugger.SetBreakPoint(Src, 'Foo2');
Debugger.SetBreakPoint(Src, 'PrgAfterFoo2');
Debugger.SetBreakPoint(Src, 'PrgAfterFoo2B');
Debugger.SetBreakPoint(Src, 'Thread1');
AssertDebuggerNotInErrorState;
// Step to break next line
@ -157,9 +160,69 @@ begin
TestLocation('Run Foo2 ended in prg', 'PrgAfterFoo2');
TestHitCnt('Run Foo2', 'Foo2', 2);
// Disable breakpoint
Debugger.BreakPointByName('Foo2').Enabled := False;
// new breakpoint
Debugger.RunToNextPause(dcStepOver);
TestLocation('Before insernt', 'New1', -1);
Debugger.SetBreakPoint(Src, 'New1');
Debugger.RunToNextPause(dcStepOver);
TestLocation('After insernt', 'New2', -1);
TestHitCnt('After insernt', 'New1', 0);
Debugger.SetBreakPoint(Src, 'New2');
Debugger.RunToNextPause(dcRun);
TestHitCnt('After insernt', 'New1', 0);
// in threads
(* In each thread set a breakpoint at the next instruction.
So when all threads are started, both should run/step OVER the breakpoint
without hitting it
*)
TestLocation('After insernt', 'Thread1');
Debugger.RunToNextPause(dcStepOver);
TestLocation('After insernt', 'Thread2', -1); // not set
loc := dbg.GetLocation;
TestEquals('loc in thread', loc.SrcLine, Src.BreakPoints['Thread2']);
b1 := dbg.BreakPoints.Add(loc.Address);
b1.InitialEnabled := True;
b1.Enabled := True;
for i := 0 to dbg.Threads.CurrentThreads.Count do
if dbg.Threads.CurrentThreads[i].ThreadId <> dbg.Threads.CurrentThreads.CurrentThreadId then begin
dbg.Threads.ChangeCurrentThread(dbg.Threads.CurrentThreads[i].ThreadId);
break;
end;
loc := dbg.GetLocation;
TestTrue('loc thread main', loc.SrcLine > Src.BreakPoints['New2']);
b2 := dbg.BreakPoints.Add(loc.Address);
b2.InitialEnabled := True;
b2.Enabled := True;
If loc.SrcLine >= Src.BreakPoints['Main2']-2 then
Debugger.SetBreakPoint(Src, 'Main1')
else
Debugger.SetBreakPoint(Src, 'Main2');
Debugger.RunToNextPause(dcRun);
If loc.SrcLine >= Src.BreakPoints['Main2']-2 then begin
TestLocation('main1', 'Main1');
Debugger.BreakPointByName('Main1').Enabled := False;
end else begin
TestLocation('main2', 'Main2');
Debugger.BreakPointByName('Main2').Enabled := False;
end;
TestEquals('b1 hits', 0, b1.HitCount);
TestEquals('b2 hits', 0, b2.HitCount);
Debugger.RunToNextPause(dcRun);
TestEquals('b1 hits after', 0, b1.HitCount);
TestEquals('b2 hits after', 0, b2.HitCount);
dbg.Stop;
finally
Debugger.ClearDebuggerMonitors;
Debugger.FreeDebugger;

5
components/lazdebuggers/lazdebugtestbase/ttestdbgexecuteables.pas
View File

@ -7,7 +7,7 @@ interface
uses
Classes, SysUtils, fgl, TestDbgConfig, TestDbgCompilerProcess,
TestOutputLogger, TTestDebuggerClasses, TestCommonSources, LazFileUtils,
FileUtil, DbgIntfDebuggerBase, fpcunit;
FileUtil, LazLoggerBase, DbgIntfDebuggerBase, fpcunit;
type
@ -403,6 +403,7 @@ function TTestDbgDebugger.RunToNextPause(ACmd: TDBGCommand; ATimeOut: Integer;
AWaitForInternal: Boolean): Boolean;
begin
Result := False;
with LazDebugger.GetLocation do DebugLnEnter('>>> RunToNextPause Starting at %s %d @ %x', [SrcFile, SrcLine, Address]);
case ACmd of
dcRun: LazDebugger.Run;
dcStepOver: LazDebugger.StepOver;
@ -414,6 +415,7 @@ begin
exit;
end;
Result := WaitForFinishRun(ATimeOut, AWaitForInternal);
with LazDebugger.GetLocation do DebugLnExit('<<< RunToNextPause Ending at %s %d @ %x %s', [SrcFile, SrcLine, Address, dbgs(LazDebugger.State)]);
end;
function TTestDbgDebugger.WaitForFinishRun(ATimeOut: Integer;
@ -445,6 +447,7 @@ begin
InitialEnabled := True;
Enabled := True;
end;
DebugLn('Inserted breakpoint %s %d id: %d', [AFileName, ALine, Result.ID]);
end;
function TTestDbgDebugger.SetBreakPoint(ACommonSource: TCommonSource;