mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-05 23:58:06 +02:00
FpDebug: Test for breakpoints in threads
git-svn-id: trunk@61835 -
This commit is contained in:
martin
parent
966ecb9382
commit
5b2858fe15
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -2630,6 +2630,7 @@ components/lazdebuggers/lazdebuggerfp/test/LazDebFpTest.lpi svneol=native#text/p
|
||||
components/lazdebuggers/lazdebuggerfp/test/LazDebFpTest.lpr svneol=native#text/plain
|
||||
components/lazdebuggers/lazdebuggerfp/test/fpclist.txt.sample svneol=native#text/plain
|
||||
components/lazdebuggers/lazdebuggerfp/test/testapps/BreakPointPrg.pas svneol=native#text/pascal
|
||||
components/lazdebuggers/lazdebuggerfp/test/testapps/BreakPointThreadPrg.pas svneol=native#text/pascal
|
||||
components/lazdebuggers/lazdebuggerfp/test/testbase.pas svneol=native#text/pascal
|
||||
components/lazdebuggers/lazdebuggerfp/test/testbreakpoint.pas svneol=native#text/pascal
|
||||
components/lazdebuggers/lazdebuggerfp/test/testvarious.pas svneol=native#text/pascal
|
||||
|
||||
@ -0,0 +1,109 @@
|
||||
program BreakPointThreadPrg;
|
||||
{$ASMMODE att}
|
||||
uses
|
||||
{$IFDEF UNIX}
|
||||
cthreads,
|
||||
{$ENDIF}
|
||||
sysutils, Classes;
|
||||
|
||||
type
|
||||
|
||||
{ TTestThread }
|
||||
|
||||
TTestThread = class(TThread)
|
||||
procedure Execute; override;
|
||||
end;
|
||||
|
||||
|
||||
var
|
||||
x, BreakDummy: Integer;
|
||||
|
||||
{$asmMode intel}
|
||||
|
||||
label
|
||||
testasmlbl1, testasmlbl2;
|
||||
|
||||
{ TTestThread }
|
||||
|
||||
procedure TTestThread.Execute;
|
||||
begin
|
||||
asm
|
||||
nop // TEST_BREAKPOINT=BrkThreadBegin
|
||||
xor eax, eax
|
||||
xor ebx, ebx
|
||||
add eax, 10
|
||||
testasmlbl1:
|
||||
sub eax, 10
|
||||
add eax, 1 // TEST_BREAKPOINT=BrkThread1
|
||||
add eax, 1 // TEST_BREAKPOINT=BrkThread2
|
||||
add eax, 1 // TEST_BREAKPOINT=BrkThread3
|
||||
add eax, 1 // TEST_BREAKPOINT=BrkThread4
|
||||
add eax, 1 // TEST_BREAKPOINT=BrkThread5
|
||||
add eax, 1 // TEST_BREAKPOINT=BrkThread6
|
||||
add eax, 1 // TEST_BREAKPOINT=BrkThread7
|
||||
add eax, 1 // TEST_BREAKPOINT=BrkThread8
|
||||
add eax, 1 // TEST_BREAKPOINT=BrkThread9
|
||||
add eax, 1 // TEST_BREAKPOINT=BrkThread10
|
||||
|
||||
add ebx, 1 // TEST_BREAKPOINT=BrkThreadIncLoop
|
||||
jmp testasmlbl1 // TEST_BREAKPOINT=BrkThread11
|
||||
|
||||
nop
|
||||
nop // TEST_BREAKPOINT=BrkThreadEnd
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
TTestThread.Create(False);
|
||||
TTestThread.Create(False);
|
||||
TTestThread.Create(False);
|
||||
TTestThread.Create(False);
|
||||
TTestThread.Create(False);
|
||||
sleep(100);
|
||||
|
||||
TTestThread.Create(False);
|
||||
TTestThread.Create(False);
|
||||
TTestThread.Create(False);
|
||||
TTestThread.Create(False);
|
||||
TTestThread.Create(False);
|
||||
|
||||
sleep(500);
|
||||
BreakDummy := 1;
|
||||
|
||||
asm
|
||||
nop // TEST_BREAKPOINT=BrkMainBegin
|
||||
xor eax, eax
|
||||
xor ebx, ebx
|
||||
add eax, 20
|
||||
testasmlbl2:
|
||||
sub eax, 20
|
||||
add eax, 1 // TEST_BREAKPOINT=BrkMain1
|
||||
add eax, 1
|
||||
add eax, 1
|
||||
add eax, 1
|
||||
add eax, 1
|
||||
add eax, 1 // TEST_BREAKPOINT=BrkMain2
|
||||
add eax, 1
|
||||
add eax, 1
|
||||
add eax, 1
|
||||
add eax, 1
|
||||
add eax, 1 // TEST_BREAKPOINT=BrkMain3
|
||||
add eax, 1
|
||||
add eax, 1
|
||||
add eax, 1
|
||||
add eax, 1
|
||||
add eax, 1
|
||||
add eax, 1
|
||||
add eax, 1
|
||||
add eax, 1
|
||||
add eax, 1
|
||||
|
||||
add ebx, 1
|
||||
jmp testasmlbl2
|
||||
|
||||
nop
|
||||
nop // TEST_BREAKPOINT=BrkMainEnd
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -5,16 +5,41 @@ unit TestBreakPoint;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, fpcunit, testutils, testregistry, TestBase, TestDbgControl,
|
||||
TestDbgTestSuites, TTestDebuggerClasses, TestOutputLogger,
|
||||
Classes, SysUtils, math, fpcunit, testutils, testregistry, TestBase,
|
||||
TestDbgControl, TestDbgTestSuites, TTestDebuggerClasses, TestOutputLogger,
|
||||
TTestWatchUtilities, TestCommonSources, TestDbgConfig, DbgIntfDebuggerBase,
|
||||
DbgIntfBaseTypes, LazLoggerBase, Forms;
|
||||
|
||||
type
|
||||
|
||||
// Info used by tests based on TestBreakPointThreadPrg
|
||||
TBreakThreadPrgInfo = record
|
||||
ThrLoopFirst, ThrLoopLast, ThrLoopLine0, ThrLoopInc: Integer;
|
||||
// -1 => Main thread
|
||||
Threads: array[-1..10] of record
|
||||
ID: Integer;
|
||||
Address: TDBGPtr;
|
||||
Line, LastLine: Integer;
|
||||
Val, LastVal: int64;
|
||||
Loop, LastLoop: int64;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TTestBreakPoint }
|
||||
|
||||
TTestBreakPoint = class(TDBGTestCase)
|
||||
protected
|
||||
// Info/Methods used by tests based on TestBreakPointThreadPrg
|
||||
FThrPrgInfo: TBreakThreadPrgInfo;
|
||||
procedure ThrPrgInitializeThreads(ATestName: String);
|
||||
procedure ThrPrgUpdateThreads(ATestName: String);
|
||||
procedure ThrPrgCheckNoSkip(ATestName: String='');
|
||||
function ThrPrgInfoHasGoneThroughLine(AIndex, ALine: Integer): boolean;
|
||||
protected
|
||||
Src: TCommonSource;
|
||||
Dbg: TDebuggerIntf;
|
||||
procedure TestLocation(ATestName, ABrkName: String; ABreakHitCount: Integer = 1);
|
||||
procedure TestHitCnt(ATestName, ABrkName: String; ABreakHitCount: Integer);
|
||||
published
|
||||
(* Ensure the debugger can correctly run/step after hidding a breakpoit
|
||||
- the original instruction is executed
|
||||
@ -23,38 +48,55 @@ type
|
||||
- breakpoints are "hit" (recognized) when stepping onto them (not actually triggering them)
|
||||
*)
|
||||
procedure TestBreakPoints;
|
||||
|
||||
(* Ensure, that while one thread steps over a breakpoint (int3 removed),
|
||||
no other thread ignores the breakpoint
|
||||
*)
|
||||
procedure TestBreakThreadsNoSkip;
|
||||
|
||||
(* Remove Breakpoints, while other threads have a pending event for the Brk.
|
||||
Make sure the other thread, still executeds the original instruction,
|
||||
hidden by the int3
|
||||
*** The test can actually NOT force multiple breakpoints to be hit.
|
||||
It only creates a high likelihood for this to happen.
|
||||
*)
|
||||
procedure TestBreakThreadsMoveBreak1;
|
||||
procedure TestBreakThreadsMoveBreak2;
|
||||
|
||||
(* TODO: All breakpoint-hits must be reported. Hits happening together with an event
|
||||
in another thread must still be reported.
|
||||
*)
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
var
|
||||
ControlTestBreak: Pointer;
|
||||
ControlTest, ControlTestBreak, ControlTestThreadNoSkip, ControlTestThreadMove1, ControlTestThreadMove2: Pointer;
|
||||
|
||||
procedure TTestBreakPoint.TestLocation(ATestName, ABrkName: String;
|
||||
ABreakHitCount: Integer);
|
||||
var
|
||||
lc: TDBGLocationRec;
|
||||
begin
|
||||
AssertDebuggerState(dsPause);
|
||||
lc := Debugger.LazDebugger.GetLocation;
|
||||
TestEquals(ATestName+' '+ABrkName+' Loc', Src.BreakPoints[ABrkName], lc.SrcLine);
|
||||
if ABreakHitCount >= 0 then
|
||||
TestEquals(ATestName+' '+ABrkName+' HitCnt', Debugger.BreakPointByName(ABrkName).HitCount, ABreakHitCount);
|
||||
end;
|
||||
|
||||
procedure TTestBreakPoint.TestHitCnt(ATestName, ABrkName: String;
|
||||
ABreakHitCount: Integer);
|
||||
begin
|
||||
TestEquals(ATestName+' '+ABrkName+' HitCnt', Debugger.BreakPointByName(ABrkName).HitCount, ABreakHitCount);
|
||||
end;
|
||||
|
||||
procedure TTestBreakPoint.TestBreakPoints;
|
||||
var
|
||||
Src: TCommonSource;
|
||||
dbg: TDebuggerIntf;
|
||||
ExeName: String;
|
||||
loc: TDBGLocationRec;
|
||||
b1, b2: TDBGBreakPoint;
|
||||
i: Integer;
|
||||
|
||||
procedure TestLocation(ATestName, ABrkName: String; ABreakHitCount: Integer = 1);
|
||||
var
|
||||
lc: TDBGLocationRec;
|
||||
begin
|
||||
AssertDebuggerState(dsPause);
|
||||
lc := dbg.GetLocation;
|
||||
TestEquals(ATestName+' '+ABrkName+' Loc', Src.BreakPoints[ABrkName], lc.SrcLine);
|
||||
if ABreakHitCount >= 0 then
|
||||
TestEquals(ATestName+' '+ABrkName+' HitCnt', Debugger.BreakPointByName(ABrkName).HitCount, ABreakHitCount);
|
||||
end;
|
||||
|
||||
procedure TestHitCnt(ATestName, ABrkName: String; ABreakHitCount: Integer);
|
||||
begin
|
||||
TestEquals(ATestName+' '+ABrkName+' HitCnt', Debugger.BreakPointByName(ABrkName).HitCount, ABreakHitCount);
|
||||
end;
|
||||
|
||||
begin
|
||||
if SkipTest then exit;
|
||||
if not TestControlCanTest(ControlTestBreak) then exit;
|
||||
@ -234,11 +276,411 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestBreakPoint.ThrPrgInitializeThreads(ATestName: String);
|
||||
var
|
||||
i, j: Integer;
|
||||
t: TThreadEntry;
|
||||
begin
|
||||
FThrPrgInfo.ThrLoopFirst := Src.BreakPoints['BrkThreadBegin'];
|
||||
FThrPrgInfo.ThrLoopLast := Src.BreakPoints['BrkThreadEnd'];
|
||||
FThrPrgInfo.ThrLoopLine0 := Src.BreakPoints['BrkThread1'];
|
||||
FThrPrgInfo.ThrLoopInc := Src.BreakPoints['BrkThreadIncLoop'];
|
||||
FThrPrgInfo.Threads[-1].ID := 0;
|
||||
(* Initialize
|
||||
Find all threads
|
||||
*)
|
||||
j := 0;
|
||||
for i := 0 to dbg.Threads.CurrentThreads.Count-1 do begin
|
||||
t := dbg.Threads.CurrentThreads.Entries[i];
|
||||
if t.TopFrame.Line < FThrPrgInfo.ThrLoopFirst then begin
|
||||
debugln(['Ignoring Thread ', t.ThreadId, ' at ',t.TopFrame.Address]);
|
||||
Continue;
|
||||
end;
|
||||
if t.TopFrame.Line > FThrPrgInfo.ThrLoopLast then begin
|
||||
debugln(['MAIN Thread ', t.ThreadId, ' at ',t.TopFrame.Address, ' line ', t.TopFrame.Line]);
|
||||
TestTrue('Only one main thread', FThrPrgInfo.Threads[-1].ID = 0);
|
||||
if FThrPrgInfo.Threads[-1].ID = 0 then
|
||||
FThrPrgInfo.Threads[-1].ID := t.ThreadId;
|
||||
Continue;
|
||||
end;
|
||||
|
||||
FThrPrgInfo.Threads[j].ID := t.ThreadId;
|
||||
debugln(['++ ADDED tid ',t.ThreadId]);
|
||||
inc(j);
|
||||
if j >= 11 then
|
||||
break;
|
||||
end;
|
||||
AssertEquals('Found 10 threads', 10, j);
|
||||
TestTrue('Found main thread', FThrPrgInfo.Threads[-1].ID <> 0);
|
||||
end;
|
||||
|
||||
procedure TTestBreakPoint.ThrPrgUpdateThreads(ATestName: String);
|
||||
var
|
||||
i, j: Integer;
|
||||
t: TThreadEntry;
|
||||
r: TRegisters;
|
||||
ax, bx: TRegisterValue;
|
||||
begin
|
||||
for i := -1 to Min(9, dbg.Threads.CurrentThreads.Count-1) do begin
|
||||
t := dbg.Threads.CurrentThreads.EntryById[FThrPrgInfo.Threads[i].ID];
|
||||
TestTrue(ATestName+' thread for '+inttostr(FThrPrgInfo.Threads[i].ID), t<> nil);
|
||||
if t=nil then
|
||||
continue;
|
||||
r := dbg.Registers.CurrentRegistersList.Entries[FThrPrgInfo.Threads[i].ID, 0];
|
||||
ax := nil;
|
||||
for j := 0 to r.Count-1 do
|
||||
if (lowercase(r.Entries[j].Name) = 'eax') or (lowercase(r.Entries[j].Name) = 'rax')
|
||||
then
|
||||
ax := r.Entries[j];
|
||||
bx := nil;
|
||||
for j := 0 to r.Count-1 do
|
||||
if (lowercase(r.Entries[j].Name) = 'ebx') or (lowercase(r.Entries[j].Name) = 'rbx')
|
||||
then
|
||||
bx := r.Entries[j];
|
||||
FThrPrgInfo.Threads[i].LastLine := FThrPrgInfo.Threads[i].Line;
|
||||
FThrPrgInfo.Threads[i].LastVal := FThrPrgInfo.Threads[i].Val;
|
||||
FThrPrgInfo.Threads[i].LastLoop := FThrPrgInfo.Threads[i].Loop;
|
||||
FThrPrgInfo.Threads[i].Address := t.TopFrame.Address;
|
||||
FThrPrgInfo.Threads[i].Line := t.TopFrame.Line;
|
||||
if ax <> nil then
|
||||
FThrPrgInfo.Threads[i].Val := StrToInt64Def(ax.Value,-1) and $7FFFFFFF;
|
||||
if bx <> nil then
|
||||
FThrPrgInfo.Threads[i].Loop := StrToInt64Def(bx.Value,-1) and $7FFFFFFF;
|
||||
|
||||
debugln('Thread %d (%x): Line: %d (%d) (was %d) Val: %d (was %d) LOOP: %d (was %d)', [
|
||||
FThrPrgInfo.Threads[i].ID, FThrPrgInfo.Threads[i].Address,
|
||||
FThrPrgInfo.Threads[i].Line-FThrPrgInfo.ThrLoopLine0, FThrPrgInfo.Threads[i].Line,
|
||||
FThrPrgInfo.Threads[i].LastLine-FThrPrgInfo.ThrLoopLine0,
|
||||
FThrPrgInfo.Threads[i].Val, FThrPrgInfo.Threads[i].LastVal,
|
||||
FThrPrgInfo.Threads[i].Loop, FThrPrgInfo.Threads[i].LastLoop]);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestBreakPoint.ThrPrgCheckNoSkip(ATestName: String);
|
||||
// Make sure no thread skipped any add. All EAX values must be correct
|
||||
var
|
||||
i, l: Integer;
|
||||
begin
|
||||
for i := 0 to 9 do begin
|
||||
l := FThrPrgInfo.Threads[i].Line - FThrPrgInfo.ThrLoopLine0;
|
||||
TestTrue(ATestName+' line in range tid: '+inttostr(FThrPrgInfo.Threads[i].ID), (l>=-1) and (l<FThrPrgInfo.ThrLoopLast-FThrPrgInfo.ThrLoopLine0));
|
||||
if l > 9 then l := 10;
|
||||
if l < 0 then l := 10;
|
||||
|
||||
TestEquals(ATestName+' Reg val for '+inttostr(FThrPrgInfo.Threads[i].ID)+ ' / '+inttostr(FThrPrgInfo.Threads[i].Line - FThrPrgInfo.ThrLoopLine0), l, FThrPrgInfo.Threads[i].Val);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TTestBreakPoint.ThrPrgInfoHasGoneThroughLine(AIndex, ALine: Integer): boolean;
|
||||
var
|
||||
LoopAdjust, LastLoopAdjust: Integer;
|
||||
begin
|
||||
Result := True;
|
||||
LoopAdjust := 0;
|
||||
if FThrPrgInfo.Threads[AIndex].Line > FThrPrgInfo.ThrLoopInc then LoopAdjust := 1;
|
||||
LastLoopAdjust := 0;
|
||||
if FThrPrgInfo.Threads[AIndex].LastLine > FThrPrgInfo.ThrLoopInc then LastLoopAdjust := 1;
|
||||
// Was in front of line, and now after (or even in next loop)?
|
||||
if (FThrPrgInfo.Threads[AIndex].LastLine < ALine) and
|
||||
( (FThrPrgInfo.Threads[AIndex].Line > ALine) or (FThrPrgInfo.Threads[AIndex].Loop-LoopAdjust <> FThrPrgInfo.Threads[AIndex].LastLoop-LastLoopAdjust) )
|
||||
then
|
||||
exit;
|
||||
// Was exactly at line, and now after AND in next loop-LoopAdjust?
|
||||
if (FThrPrgInfo.Threads[AIndex].LastLine = ALine) and
|
||||
(FThrPrgInfo.Threads[AIndex].Line > ALine) and (FThrPrgInfo.Threads[AIndex].Loop-LoopAdjust <> FThrPrgInfo.Threads[AIndex].LastLoop-LastLoopAdjust)
|
||||
then
|
||||
exit;
|
||||
// Was after front of line, and now after AND in next loop-LoopAdjust?
|
||||
if (FThrPrgInfo.Threads[AIndex].LastLine < ALine) and
|
||||
(FThrPrgInfo.Threads[AIndex].Line > ALine) and (FThrPrgInfo.Threads[AIndex].Loop-LoopAdjust <> FThrPrgInfo.Threads[AIndex].LastLoop-LastLoopAdjust)
|
||||
then
|
||||
exit;
|
||||
// More than one loop-LoopAdjust ...
|
||||
if (FThrPrgInfo.Threads[AIndex].Loop-LoopAdjust > FThrPrgInfo.Threads[AIndex].LastLoop-LastLoopAdjust + 1)
|
||||
then
|
||||
exit;
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
procedure TTestBreakPoint.TestBreakThreadsNoSkip;
|
||||
procedure HasManyAtLine(ALine: Integer; var AManyAt, AManyAfter: Integer);
|
||||
var
|
||||
AtLine, AfterLine, i: Integer;
|
||||
begin
|
||||
AtLine := 0;
|
||||
AfterLine := 0;
|
||||
for i := 0 to 9 do
|
||||
if FThrPrgInfo.Threads[i].Line = ALine then
|
||||
inc(AtLine)
|
||||
else
|
||||
if FThrPrgInfo.Threads[i].LastLine = ALine then // Current line moved on, stepped over break
|
||||
inc(AfterLine);
|
||||
if AtLine > 1 then Inc(AManyAt);
|
||||
if AfterLine > 1 then Inc(AManyAfter);
|
||||
end;
|
||||
var
|
||||
ExeName: String;
|
||||
i, j, AtBrk1, AfterBrk1: Integer;
|
||||
MainBrk, Brk1, Brk2, Brk3, Brk4, Brk5: TDBGBreakPoint;
|
||||
ManyAtBrk1, ManyAfterBrk1: Integer;
|
||||
begin
|
||||
if SkipTest then exit;
|
||||
if not TestControlCanTest(ControlTestThreadNoSkip) then exit;
|
||||
Src := GetCommonSourceFor(AppDir + 'BreakPointThreadPrg.pas');
|
||||
TestCompile(Src, ExeName);
|
||||
|
||||
TestTrue('Start debugger', Debugger.StartDebugger(AppDir, ExeName));
|
||||
dbg := Debugger.LazDebugger;
|
||||
|
||||
try
|
||||
MainBrk := Debugger.SetBreakPoint(Src, 'BrkMain1');
|
||||
AssertDebuggerNotInErrorState;
|
||||
Debugger.RunToNextPause(dcRun);
|
||||
AssertDebuggerState(dsPause);
|
||||
|
||||
ThrPrgInitializeThreads('');
|
||||
ThrPrgUpdateThreads('Init');
|
||||
ThrPrgCheckNoSkip('Init');
|
||||
|
||||
(* Stopped in the main thread.
|
||||
Set fixed breakpoints in the thread loop.
|
||||
On each run, no thread must step over any of the breakpoints.
|
||||
|
||||
Since threads do reach the breakpoints, they will have to temp remove them
|
||||
*)
|
||||
MainBrk.Enabled := False;
|
||||
|
||||
Brk1 := Debugger.SetBreakPoint(Src, 'BrkThread1');
|
||||
|
||||
ManyAtBrk1 := 0;
|
||||
ManyAfterBrk1 := 0;
|
||||
for j := 0 to 200 do begin
|
||||
AssertDebuggerNotInErrorState;
|
||||
Debugger.RunToNextPause(dcRun);
|
||||
AssertDebuggerState(dsPause);
|
||||
|
||||
ThrPrgUpdateThreads('loop fixed brk '+IntToStr(j));
|
||||
ThrPrgCheckNoSkip('loop, fixed brk '+IntToStr(j));
|
||||
|
||||
for i := 0 to 9 do begin
|
||||
TestTrue('THread not gone over break 1 at line '+IntToStr(Brk1.Line)+' '+IntToStr(i),
|
||||
not ThrPrgInfoHasGoneThroughLine(i, Brk1.Line)
|
||||
);
|
||||
|
||||
HasManyAtLine(Brk1.Line, ManyAtBrk1, ManyAfterBrk1);
|
||||
end;
|
||||
|
||||
if (i > 50) and (ManyAtBrk1 > 5) and (ManyAfterBrk1 > 5) then begin
|
||||
DebugLn('~~~~~~~~~~~~~ End loop early i=%d at=%d after=%d', [i, ManyAtBrk1, ManyAfterBrk1]);
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
TestTrue('Had Many at brk1 (loop1)', ManyAtBrk1 > 0, 0, 'Ignore / not enforcable');
|
||||
TestTrue('Had Many after brk1 (loop1)', ManyAfterBrk1 > 0, 0, 'Ignore / not enforcable');
|
||||
|
||||
// Add more breaks
|
||||
Brk3 := Debugger.SetBreakPoint(Src, 'BrkThread5');
|
||||
Brk5 := Debugger.SetBreakPoint(Src, 'BrkThread9');
|
||||
|
||||
for j := 0 to 100 do begin
|
||||
AssertDebuggerNotInErrorState;
|
||||
Debugger.RunToNextPause(dcRun);
|
||||
AssertDebuggerState(dsPause);
|
||||
|
||||
ThrPrgUpdateThreads('loop fixed brk '+IntToStr(j));
|
||||
ThrPrgCheckNoSkip('loop, fixed brk '+IntToStr(j));
|
||||
|
||||
for i := 0 to 9 do begin
|
||||
TestTrue('THread not gone over break 1 at line '+IntToStr(Brk1.Line)+' '+IntToStr(i),
|
||||
not ThrPrgInfoHasGoneThroughLine(i, Brk1.Line)
|
||||
);
|
||||
TestTrue('THread not gone over break 3 at line '+IntToStr(Brk3.Line)+' '+IntToStr(i),
|
||||
not ThrPrgInfoHasGoneThroughLine(i, Brk3.Line)
|
||||
);
|
||||
TestTrue('THread not gone over break 5 at line '+IntToStr(Brk5.Line)+' '+IntToStr(i),
|
||||
not ThrPrgInfoHasGoneThroughLine(i, Brk5.Line)
|
||||
);
|
||||
end;
|
||||
end;
|
||||
|
||||
// Add more breaks
|
||||
Brk2 := Debugger.SetBreakPoint(Src, 'BrkThread3');
|
||||
Brk4 := Debugger.SetBreakPoint(Src, 'BrkThread7');
|
||||
|
||||
for j := 0 to 100 do begin
|
||||
AssertDebuggerNotInErrorState;
|
||||
Debugger.RunToNextPause(dcRun);
|
||||
AssertDebuggerState(dsPause);
|
||||
|
||||
ThrPrgUpdateThreads('loop fixed brk '+IntToStr(j));
|
||||
ThrPrgCheckNoSkip('loop, fixed brk '+IntToStr(j));
|
||||
|
||||
for i := 0 to 9 do begin
|
||||
TestTrue('THread not gone over break 1 at line '+IntToStr(Brk1.Line)+' '+IntToStr(i),
|
||||
not ThrPrgInfoHasGoneThroughLine(i, Brk1.Line)
|
||||
);
|
||||
TestTrue('THread not gone over break 2 at line '+IntToStr(Brk2.Line)+' '+IntToStr(i),
|
||||
not ThrPrgInfoHasGoneThroughLine(i, Brk2.Line)
|
||||
);
|
||||
TestTrue('THread not gone over break 3 at line '+IntToStr(Brk3.Line)+' '+IntToStr(i),
|
||||
not ThrPrgInfoHasGoneThroughLine(i, Brk3.Line)
|
||||
);
|
||||
TestTrue('THread not gone over break 4 at line '+IntToStr(Brk4.Line)+' '+IntToStr(i),
|
||||
not ThrPrgInfoHasGoneThroughLine(i, Brk4.Line)
|
||||
);
|
||||
TestTrue('THread not gone over break 5 at line '+IntToStr(Brk5.Line)+' '+IntToStr(i),
|
||||
not ThrPrgInfoHasGoneThroughLine(i, Brk5.Line)
|
||||
);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
dbg.Stop;
|
||||
finally
|
||||
Debugger.ClearDebuggerMonitors;
|
||||
Debugger.FreeDebugger;
|
||||
|
||||
AssertTestErrors;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestBreakPoint.TestBreakThreadsMoveBreak1;
|
||||
var
|
||||
ExeName: String;
|
||||
i, j: Integer;
|
||||
MainBrk, Brk1: TDBGBreakPoint;
|
||||
begin
|
||||
if SkipTest then exit;
|
||||
if not TestControlCanTest(ControlTestThreadMove1) then exit;
|
||||
Src := GetCommonSourceFor(AppDir + 'BreakPointThreadPrg.pas');
|
||||
TestCompile(Src, ExeName);
|
||||
|
||||
TestTrue('Start debugger', Debugger.StartDebugger(AppDir, ExeName));
|
||||
dbg := Debugger.LazDebugger;
|
||||
|
||||
try
|
||||
MainBrk := Debugger.SetBreakPoint(Src, 'BrkMain1');
|
||||
AssertDebuggerNotInErrorState;
|
||||
Debugger.RunToNextPause(dcRun);
|
||||
AssertDebuggerState(dsPause);
|
||||
|
||||
ThrPrgInitializeThreads('');
|
||||
ThrPrgUpdateThreads('Init');
|
||||
ThrPrgCheckNoSkip('Init');
|
||||
|
||||
(* Stopped in the main thread.
|
||||
Set a new breakpoint at the current address of one of the subthreads.
|
||||
It should be skipped until next loop.
|
||||
Other sub-thread must not accidentally go over the breakpoint for sub-threads
|
||||
*)
|
||||
|
||||
for j := 0 to 100 do begin
|
||||
Brk1 := Debugger.SetBreakPoint(Src.FileName, FThrPrgInfo.Threads[0].Line);
|
||||
AssertDebuggerNotInErrorState;
|
||||
Debugger.RunToNextPause(dcRun);
|
||||
AssertDebuggerState(dsPause);
|
||||
|
||||
ThrPrgUpdateThreads('loop one brk '+IntToStr(j));
|
||||
ThrPrgCheckNoSkip('loop, one brk '+IntToStr(j));
|
||||
|
||||
for i := 0 to 9 do begin
|
||||
TestTrue('THread not gone over break at line '+IntToStr(Brk1.Line)+' '+IntToStr(i),
|
||||
not ThrPrgInfoHasGoneThroughLine(i, Brk1.Line)
|
||||
);
|
||||
end;
|
||||
|
||||
Brk1.ReleaseReference;
|
||||
if j = 0 then
|
||||
MainBrk.Enabled := False;
|
||||
end;
|
||||
|
||||
dbg.Stop;
|
||||
finally
|
||||
Debugger.ClearDebuggerMonitors;
|
||||
Debugger.FreeDebugger;
|
||||
|
||||
AssertTestErrors;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestBreakPoint.TestBreakThreadsMoveBreak2;
|
||||
var
|
||||
ExeName: String;
|
||||
i, j: Integer;
|
||||
MainBrk, Brk1, Brk2, Brk3, Brk4, Brk5: TDBGBreakPoint;
|
||||
begin
|
||||
if SkipTest then exit;
|
||||
if not TestControlCanTest(ControlTestThreadMove2) then exit;
|
||||
Src := GetCommonSourceFor(AppDir + 'BreakPointThreadPrg.pas');
|
||||
TestCompile(Src, ExeName);
|
||||
|
||||
TestTrue('Start debugger', Debugger.StartDebugger(AppDir, ExeName));
|
||||
dbg := Debugger.LazDebugger;
|
||||
|
||||
try
|
||||
MainBrk := Debugger.SetBreakPoint(Src, 'BrkMain1');
|
||||
AssertDebuggerNotInErrorState;
|
||||
Debugger.RunToNextPause(dcRun);
|
||||
AssertDebuggerState(dsPause);
|
||||
|
||||
ThrPrgInitializeThreads('');
|
||||
ThrPrgUpdateThreads('Init');
|
||||
ThrPrgCheckNoSkip('Init');
|
||||
|
||||
(* Try more breakpoints => so there is a likelihood that a several threads
|
||||
hit breakpoints at the same time.
|
||||
Then remove the breakpoints, while the FThrPrgInfo.ThrLoopFirst thread reports the hit
|
||||
*)
|
||||
for j := 0 to 150 do begin
|
||||
if (j and 1) = 0 then begin
|
||||
Brk1 := Debugger.SetBreakPoint(Src, 'BrkThread1');
|
||||
Brk2 := Debugger.SetBreakPoint(Src, 'BrkThread3');
|
||||
Brk3 := Debugger.SetBreakPoint(Src, 'BrkThread5');
|
||||
Brk4 := Debugger.SetBreakPoint(Src, 'BrkThread7');
|
||||
Brk5 := Debugger.SetBreakPoint(Src, 'BrkThread9');
|
||||
end else begin
|
||||
Brk1 := Debugger.SetBreakPoint(Src, 'BrkThread2');
|
||||
Brk2 := Debugger.SetBreakPoint(Src, 'BrkThread4');
|
||||
Brk3 := Debugger.SetBreakPoint(Src, 'BrkThread6');
|
||||
Brk4 := Debugger.SetBreakPoint(Src, 'BrkThread8');
|
||||
Brk5 := Debugger.SetBreakPoint(Src, 'BrkThread10');
|
||||
end;
|
||||
AssertDebuggerNotInErrorState;
|
||||
Debugger.RunToNextPause(dcRun);
|
||||
AssertDebuggerState(dsPause);
|
||||
|
||||
ThrPrgUpdateThreads('loop, changing brk '+IntToStr(j));
|
||||
ThrPrgCheckNoSkip('loop, changing brk '+IntToStr(j));
|
||||
|
||||
for i := 0 to 9 do begin
|
||||
TestTrue('THread not gone over break '+IntToStr(i), not ThrPrgInfoHasGoneThroughLine(i, Brk1.Line) );
|
||||
TestTrue('THread not gone over break '+IntToStr(i), not ThrPrgInfoHasGoneThroughLine(i, Brk2.Line) );
|
||||
TestTrue('THread not gone over break '+IntToStr(i), not ThrPrgInfoHasGoneThroughLine(i, Brk3.Line) );
|
||||
TestTrue('THread not gone over break '+IntToStr(i), not ThrPrgInfoHasGoneThroughLine(i, Brk4.Line) );
|
||||
TestTrue('THread not gone over break '+IntToStr(i), not ThrPrgInfoHasGoneThroughLine(i, Brk5.Line) );
|
||||
end;
|
||||
|
||||
Brk1.ReleaseReference; Brk2.ReleaseReference; Brk3.ReleaseReference; Brk4.ReleaseReference; Brk5.ReleaseReference;
|
||||
end;
|
||||
|
||||
|
||||
dbg.Stop;
|
||||
finally
|
||||
Debugger.ClearDebuggerMonitors;
|
||||
Debugger.FreeDebugger;
|
||||
|
||||
AssertTestErrors;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
|
||||
RegisterDbgTest(TTestBreakPoint);
|
||||
ControlTestBreak := TestControlRegisterTest('TTestBreakPoint');
|
||||
ControlTest := TestControlRegisterTest('TTestBreak');
|
||||
ControlTestBreak := TestControlRegisterTest('TTestBreakPoint', ControlTest);
|
||||
ControlTestThreadNoSkip := TestControlRegisterTest('TTestBreakThreadNoSkip', ControlTest);
|
||||
ControlTestThreadMove1 := TestControlRegisterTest('TTestBreakThreadMove1', ControlTest);
|
||||
ControlTestThreadMove2 := TestControlRegisterTest('TTestBreakThreadMove2', ControlTest);
|
||||
end.
|
||||
|
||||
|
||||
@ -414,10 +414,13 @@ begin
|
||||
exit;
|
||||
end;
|
||||
Result := WaitForFinishRun(ATimeOut, AWaitForInternal);
|
||||
with LazDebugger.GetLocation do begin
|
||||
DebugLnExit('<<< RunToNextPause Ending at %s %d @ %x %s', [SrcFile, SrcLine, Address, dbgs(LazDebugger.State)]);
|
||||
TestLogger.DebugLn('at %s %d @ %x %s', [SrcFile, SrcLine, Address, dbgs(LazDebugger.State)]);
|
||||
end;
|
||||
if LazDebugger.State = dsPause then
|
||||
with LazDebugger.GetLocation do begin
|
||||
DebugLnExit('<<< RunToNextPause Ending at %s %d @ %x %s', [SrcFile, SrcLine, Address, dbgs(LazDebugger.State)]);
|
||||
TestLogger.DebugLn('at %s %d @ %x %s', [SrcFile, SrcLine, Address, dbgs(LazDebugger.State)]);
|
||||
end
|
||||
else
|
||||
DebugLnExit(['<<< RunToNextPause - ERROR: not paused']);
|
||||
end;
|
||||
|
||||
function TTestDbgDebugger.WaitForFinishRun(ATimeOut: Integer;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user