paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-13 00:12:33 +02:00
Code Issues Packages Projects Releases Wiki Activity
add996429b
lazarus/components/lazdebuggers/lazdebuggerfp/test/teststepping.pas
Martin 81b8660cb1 FpDebug: tests, increase timeout
2023-05-27 10:18:41 +02:00

1220 lines
48 KiB
ObjectPascal
Raw Blame History

unit TestStepping;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, math, TestDbgControl, TestDbgTestSuites, TestBase,
TTestWatchUtilities, TestCommonSources, TestDbgConfig, TestOutputLogger,
FpDebugDebugger, FpDebugDebuggerUtils, LazDebuggerIntf,
LazDebuggerIntfBaseTypes, DbgIntfDebuggerBase, DbgIntfBaseTypes,
{$ifdef FORCE_LAZLOGGER_DUMMY} LazLoggerDummy {$else} LazLoggerBase {$endif}, Forms;
type
{ TTestStepping }
TTestStepping = class(TDBGTestCase)
protected
Src: TCommonSource;
Dbg: TDebuggerIntf;
FGotExceptCount: Integer;
FGotExceptClass: String;
FGotExceptMsg: String;
FGotExceptType: TDBGExceptionType;
FGotExceptionLocation: TDBGLocationRec;
FContinue: Boolean;
function TestLocation(ATestName, ABrkName: String; ABreakHitCount: Integer = 1; AnAcceptLinesBefore: integer = 0): Boolean; // only line-number
procedure TestLoopCount(ATestName: String);
function IsAtLocation(ABrkName: String; ATrueOnNoLine: Boolean = False): Boolean; // only line-number
procedure DoDebuggerException(Sender: TObject;
const AExceptionType: TDBGExceptionType;
const AExceptionClass: String;
const AExceptionLocation: TDBGLocationRec;
const AExceptionText: String;
out AContinue: Boolean);
function StepOverToLine(ATestName, ABrkName: String; AnExitIfNoLineInfo: Boolean = False;
ACmd: TDBGCommand = dcStepOver; AMaxSteps: Integer = 100; AForbiddenLine: String = ''): Boolean;
function StepIfAtLine(ATestName, ABrkName: String; ACmd: TDBGCommand = dcStepOver; AnExpAtBrkName: String = ''): Boolean;
procedure DoTestStepOver(ANextOnlyStopOnStartLine: Boolean);
procedure DoTestStepOverInstr(ANextOnlyStopOnStartLine: Boolean);
procedure DoTestExceptionStepOutEx(ANextOnlyStopOnStartLine: Boolean);
procedure DoTestExceptionStepOverEx(ANextOnlyStopOnStartLine: Boolean);
procedure DoTestStepTryBlocks(ANextOnlyStopOnStartLine: Boolean);
public
function RunToNextPauseNoLoopBreak(AName: String; ACmd: TDBGCommand; ATimeOut: Integer;
AnExpAtBrkName: String = ''; AnExpAcceptLinesBefore: integer = 0): Boolean;
function RunToNextPauseNoLoopBreak(AName: String; ACmd: TDBGCommand;
AnExpAtBrkName: String = ''; AnExpAcceptLinesBefore: integer = 0): Boolean;
function RunToNextPauseEx(AName: String; ACmd: TDBGCommand;
AnExpAtBrkName: String = ''; AnExpAcceptLinesBefore: integer = 0): Boolean;
published
(* Step over to work with various events happening during the step
- creation/exit of threads
- ignored breakpoints (same thread / other thread)
- TODO: ignored exception: caught inside the step
- TODO: ignored exception: caught caught outside the step (step to except/finally)
*)
procedure TestStepOver;
procedure TestStepOverInstr;
procedure TestExceptionStepOutEx;
procedure TestExceptionStepOverEx;
procedure TestStepTryBlocks;
procedure TestStepOver_NextOnlyFalse;
procedure TestStepOverInstr_NextOnlyFalse;
procedure TestExceptionStepOutEx_NextOnlyFalse;
procedure TestExceptionStepOverEx_NextOnlyFalse;
procedure TestStepTryBlocks_NextOnlyFalse;
end;
implementation
var
ControlTest,
ControlTest_NextOnlyTrue, ControlTestStepOver, ControlTestStepOverInstr,
ControlTestExceptionStepOutEx, ControlTestExceptionStepOverEx, ControlTestStepTryBlocks: Pointer;
ControlTest_NextOnly, ControlTestStepOver_NextOnly, ControlTestStepOverInstr_NextOnly,
ControlTestExceptionStepOutEx_NextOnly, ControlTestExceptionStepOverEx_NextOnly, ControlTestStepTryBlocks_NextOnly: Pointer;
function TTestStepping.TestLocation(ATestName, ABrkName: String;
ABreakHitCount: Integer; AnAcceptLinesBefore: integer): Boolean;
var
lc: TDBGLocationRec;
brk: LongInt;
begin
Result := True;
AssertDebuggerState(dsPause);
lc := Debugger.LazDebugger.GetLocation;
brk := Src.BreakPoints[ABrkName];
if (AnAcceptLinesBefore > 0) and (lc.SrcLine < brk) and (lc.SrcLine >= brk - AnAcceptLinesBefore)
then
Result := TestEquals(ATestName+' '+ABrkName+' Loc', brk, lc.SrcLine, 0, 'Ignored - In AcceptLinesBefore range')
else
Result := TestEquals(ATestName+' '+ABrkName+' Loc', brk, lc.SrcLine);
if ABreakHitCount >= 0 then
if not TestEquals(ATestName+' '+ABrkName+' HitCnt', Debugger.BreakPointByName(ABrkName).HitCount, ABreakHitCount)
then
Result := False;
end;
procedure TTestStepping.TestLoopCount(ATestName: String);
begin
TestEquals(ATestName+' - No unexpected breaks of debugloop', 1, THookedFpDebugDebugger(dbg).LockRelCount);
THookedFpDebugDebugger(dbg).LockRelCount := 0;
end;
function TTestStepping.IsAtLocation(ABrkName: String; ATrueOnNoLine: Boolean
): Boolean;
var
lc: TDBGLocationRec;
begin
lc := Debugger.LazDebugger.GetLocation;
if (lc.SrcFile = '') then
exit(ATrueOnNoLine);
Result := Src.BreakPoints[ABrkName] = lc.SrcLine;
end;
procedure TTestStepping.DoDebuggerException(Sender: TObject;
const AExceptionType: TDBGExceptionType; const AExceptionClass: String;
const AExceptionLocation: TDBGLocationRec; const AExceptionText: String; out
AContinue: Boolean);
begin
inc(FGotExceptCount);
FGotExceptClass := AExceptionClass;
FGotExceptMsg := AExceptionText;
FGotExceptType := AExceptionType;
FGotExceptionLocation := AExceptionLocation;
AContinue := FContinue;
end;
function TTestStepping.StepOverToLine(ATestName, ABrkName: String;
AnExitIfNoLineInfo: Boolean; ACmd: TDBGCommand; AMaxSteps: Integer;
AForbiddenLine: String): Boolean;
var
i: Integer;
begin
Result := False;
ATestName := ATestName + dbgs(ACmd) + 'TO: ' + ABrkName + ' (StepOverToLine) ';
i := 1;
while (i <= AMaxSteps) and (not IsAtLocation(ABrkName, AnExitIfNoLineInfo)) do begin
RunToNextPauseNoLoopBreak(ATestName+' '+IntToStr(i), ACmd);
AssertDebuggerState(dsPause, ATestName);
if (AForbiddenLine <> '') and IsAtLocation(AForbiddenLine, False) then
TestFalse(ATestName+' FORBIDDEN LINE '+AForbiddenLine, True);
inc(i);
end;
Result := IsAtLocation(ABrkName, AnExitIfNoLineInfo);
if not AnExitIfNoLineInfo then
TestLocation(ATestName, ABrkName, -1);
debugln(['XXXXXXXXXXXXXXXXXXXXXXXX to ', ABrkName, ' ',ATestName]);
end;
function TTestStepping.StepIfAtLine(ATestName, ABrkName: String;
ACmd: TDBGCommand; AnExpAtBrkName: String): Boolean;
begin
Result := True;
ATestName := ATestName + dbgs(ACmd) + ' (StepIfAtLine) ';
if not IsAtLocation(ABrkName) then
exit;
RunToNextPauseNoLoopBreak(ATestName, ACmd);
TestTrue(ATestName+' finally entered at begin (not end) / '+ ABrkName, False, 0, 'ignore');
AssertDebuggerState(dsPause, ATestName);
debugln(['XXXXXXXXXXXXXXXXXXXXXXXX STEPPED from END LINE to begin??? ', ABrkName, ' ',ATestName]);
if AnExpAtBrkName <> '' then
TestLocation(ATestName+': Finished at Line ', AnExpAtBrkName, -1);
end;
procedure TTestStepping.DoTestStepOver(ANextOnlyStopOnStartLine: Boolean);
var
ExeName: String;
MainBrk, BrkDis, BrkHitCnt: TDBGBreakPoint;
ThreadIdMain: Integer;
begin
Src := GetCommonSourceFor(AppDir + 'StepOverPrg.pas');
TestCompile(Src, ExeName);
TestTrue('Start debugger', Debugger.StartDebugger(AppDir, ExeName));
dbg := Debugger.LazDebugger;
TFpDebugDebuggerProperties(dbg.GetProperties).NextOnlyStopOnStartLine := ANextOnlyStopOnStartLine;
try
MainBrk := Debugger.SetBreakPoint(Src, 'BrkStart');
Debugger.SetBreakPoint(Src, 'BrkThreadCreateInStep');
Debugger.SetBreakPoint(Src, 'BrkInterfereByThread');
Debugger.SetBreakPoint(Src, 'BrkNested');
Debugger.SetBreakPoint(Src, 'CallStepOverEnd');
BrkDis := Debugger.SetBreakPoint(Src, 'BrkDisabled');
BrkHitCnt := Debugger.SetBreakPoint(Src, 'BrkHitCnt');
BrkDis.Enabled := False;
BrkHitCnt.BreakHitCount := 999;
AssertDebuggerNotInErrorState;
RunToNextPauseNoInternal('', dcRun);
AssertDebuggerState(dsPause);
TestLocation('Init', 'BrkStart');
ThreadIdMain := dbg.Threads.CurrentThreads.CurrentThreadId;
// Step over a line
RunToNextPauseNoLoopBreak('', dcStepOver);
AssertDebuggerState(dsPause);
TestLocation('At AfterStep', 'AfterStep', -1);
// Step over a longer line
RunToNextPauseNoLoopBreak('', dcStepOver);
AssertDebuggerState(dsPause);
TestLocation('At AfterStepLongLine', 'AfterStepLongLine', -1);
// Step over a subroutine call
RunToNextPauseNoLoopBreak('', dcStepOver);
AssertDebuggerState(dsPause);
TestLocation('At AfterStepProc', 'AfterStepProc', -1);
// Step over a several subroutine calls
RunToNextPauseNoLoopBreak('', dcStepOver);
AssertDebuggerState(dsPause);
TestLocation('At AfterStepProcLong', 'AfterStepProcLong', -1);
// Step over a subroutine call, with sleep
RunToNextPauseNoLoopBreak('', dcStepOver);
AssertDebuggerState(dsPause);
TestLocation('At AfterStepSleepProc', 'AfterStepSleepProc', -1);
// Step over a call to sleep
RunToNextPauseNoLoopBreak('', dcStepOver);
AssertDebuggerState(dsPause);
TestLocation('At AfterStepSleep', 'AfterStepSleep', -1);
// Step over a subroutine call, with a disabled breakpoint
RunToNextPauseNoLoopBreak('', dcStepOver);
AssertDebuggerState(dsPause);
TestLocation('At AfterStepBrkDis', 'AfterStepBrkDis', -1);
// Step over a subroutine call, with a breakpoint that continues
// No internal pause should happen
RunToNextPauseTestInternal('', 0, dcStepOver);
AssertDebuggerState(dsPause);
TestLocation('At AfterStepBrkHitCnt', 'AfterStepBrkHitCnt', -1);
TestEquals('No Hit for disabled break', 0, BrkDis.HitCount);
TestEquals('No Hit for skipped break', 1, BrkHitCnt.HitCount);
BrkDis.Enabled := True;
// Step over a subroutine call, BUT STOP at the breakpoint within it
RunToNextPauseNoLoopBreak('', dcStepOver);
AssertDebuggerState(dsPause);
TestLocation('At BrkDisabled', 'BrkDisabled', -1);
// And do another step
RunToNextPauseNoLoopBreak('', dcStepOver);
AssertDebuggerState(dsPause);
TestEquals('No Hit for disabled break', 1, BrkDis.HitCount);
TestEquals('No Hit for skipped break', 1, BrkHitCnt.HitCount);
// Step over a RECURSIVE subroutine call
RunToNextPauseNoLoopBreak('', dcRun);
AssertDebuggerState(dsPause);
TestLocation('At BrkNested', 'BrkNested', -1);
RunToNextPauseNoLoopBreak('', dcStepOver);
AssertDebuggerState(dsPause);
RunToNextPauseNoLoopBreak('', dcStepOver);
AssertDebuggerState(dsPause);
TestLocation('At AfterNested', 'AfterNested', -1);
(* The debugger will encounter a thread create event, during the stepping
This will mean the main-loop's FCurrentThread is the new thread
*)
RunToNextPauseNoLoopBreak('', dcRun, 45000);
AssertDebuggerState(dsPause);
TestLocation('At BrkThreadCreateInStep', 'BrkThreadCreateInStep', -1);
// This test can take longer, as the new thread gets very little scheduler time
// during the single stepping of the main thread.
RunToNextPauseNoLoopBreak('', dcStepOver, 55000);
AssertDebuggerState(dsPause);
TestLocation('At AfterThreadCreateInStep', 'AfterThreadCreateInStep', -1);
TestEquals('ThreadId AfterThreadCreateInStep', ThreadIdMain, dbg.Threads.CurrentThreads.CurrentThreadId);
(* The debugger will step over a call.
Other threads will hit the FHiddenBreakpoint
*)
RunToNextPauseNoLoopBreak('', dcRun);
AssertDebuggerState(dsPause);
TestLocation('At BrkInterfereByThread', 'BrkInterfereByThread', -1);
RunToNextPauseNoLoopBreak('', dcStepOver);
RunToNextPauseNoLoopBreak('', dcStepOver);
AssertDebuggerState(dsPause);
TestLocation('At AfterInterfereByThread', 'AfterInterfereByThread', -1);
TestEquals('ThreadId AfterInterfereByThread', ThreadIdMain, dbg.Threads.CurrentThreads.CurrentThreadId);
(* go to CallMyNested
Step into, and step to endline
=> ensure "end" takes ONE step to leave
*)
RunToNextPauseNoLoopBreak('', dcRun);
TestLocation('At CallStepOverEnd', 'CallStepOverEnd', -1);
RunToNextPauseNoLoopBreak('', dcStepInto);
RunToNextPauseNoLoopBreak('', dcStepOver);
if not IsAtLocation('StepOverEnd') then // depends on "begin" was code or not
RunToNextPauseNoLoopBreak('', dcStepOver);
RunToNextPauseNoLoopBreak('', dcStepInto);
RunToNextPauseNoLoopBreak('', dcStepOver);
if not IsAtLocation('StepOverEnd') then // depends on "begin" was code or not
RunToNextPauseNoLoopBreak('', dcStepOver);
TestLocation('At StepOverEnd', 'StepOverEnd', -1);
RunToNextPauseNoLoopBreak('', dcStepOver);
RunToNextPauseNoLoopBreak('', dcStepOver);
TestLocation('At AfterCallStepOverEnd', 'AfterCallStepOverEnd', -1);
dbg.Stop;
finally
Debugger.FreeDebugger;
AssertTestErrors;
end;
end;
procedure TTestStepping.TestStepOver;
begin
if SkipTest then exit;
if not TestControlCanTest(ControlTestStepOver) then exit;
DoTestStepOver(True);
end;
procedure TTestStepping.TestStepOverInstr;
begin
if SkipTest then exit;
if not TestControlCanTest(ControlTestStepOverInstr) then exit;
DoTestStepOverInstr(True);
end;
procedure TTestStepping.TestExceptionStepOutEx;
begin
if SkipTest then exit;
if not TestControlCanTest(ControlTestExceptionStepOutEx) then exit;
DoTestExceptionStepOutEx(True);
end;
procedure TTestStepping.TestExceptionStepOverEx;
begin
if SkipTest then exit;
if not TestControlCanTest(ControlTestExceptionStepOverEx) then exit;
DoTestExceptionStepOverEx(True);
end;
procedure TTestStepping.TestStepTryBlocks;
begin
if SkipTest then exit;
if not TestControlCanTest(ControlTestStepTryBlocks) then exit;
DoTestStepTryBlocks(True);
end;
procedure TTestStepping.TestStepOver_NextOnlyFalse;
begin
if SkipTest then exit;
if not TestControlCanTest(ControlTestStepOver_NextOnly) then exit;
DoTestStepOver(False);
end;
procedure TTestStepping.TestStepOverInstr_NextOnlyFalse;
begin
if SkipTest then exit;
if not TestControlCanTest(ControlTestStepOverInstr_NextOnly) then exit;
DoTestStepOverInstr(False);
end;
procedure TTestStepping.TestExceptionStepOutEx_NextOnlyFalse;
begin
if SkipTest then exit;
if not TestControlCanTest(ControlTestExceptionStepOutEx_NextOnly) then exit;
DoTestExceptionStepOutEx(False);
end;
procedure TTestStepping.TestExceptionStepOverEx_NextOnlyFalse;
begin
if SkipTest then exit;
if not TestControlCanTest(ControlTestExceptionStepOverEx_NextOnly) then exit;
DoTestExceptionStepOverEx(False);
end;
procedure TTestStepping.TestStepTryBlocks_NextOnlyFalse;
begin
if SkipTest then exit;
if not TestControlCanTest(ControlTestStepTryBlocks_NextOnly) then exit;
DoTestStepTryBlocks(False);
end;
procedure TTestStepping.DoTestStepOverInstr(ANextOnlyStopOnStartLine: Boolean);
procedure StepInstrToNextLine(AName: String; AnExpIntPauseCnt: integer = 0);
var
lc: TDBGLocationRec;
begin
lc := Debugger.LazDebugger.GetLocation;
repeat
RunToNextPauseTestInternal('', AnExpIntPauseCnt, dcStepOverInstr);
AssertDebuggerState(dsPause, 'step instr '+AName);
until (lc.SrcLine <> Debugger.LazDebugger.GetLocation.SrcLine);
end;
var
ExeName: String;
MainBrk, BrkDis, BrkHitCnt: TDBGBreakPoint;
ThreadIdMain: Integer;
begin
Src := GetCommonSourceFor(AppDir + 'StepOverPrg.pas');
TestCompile(Src, ExeName);
TestTrue('Start debugger', Debugger.StartDebugger(AppDir, ExeName));
dbg := Debugger.LazDebugger;
TFpDebugDebuggerProperties(dbg.GetProperties).NextOnlyStopOnStartLine := ANextOnlyStopOnStartLine;
try
MainBrk := Debugger.SetBreakPoint(Src, 'BrkStart');
Debugger.SetBreakPoint(Src, 'BrkThreadCreateInStep');
Debugger.SetBreakPoint(Src, 'BrkInterfereByThread');
Debugger.SetBreakPoint(Src, 'BrkNested');
BrkDis := Debugger.SetBreakPoint(Src, 'BrkDisabled');
BrkHitCnt := Debugger.SetBreakPoint(Src, 'BrkHitCnt');
BrkDis.Enabled := False;
BrkHitCnt.BreakHitCount := 999;
AssertDebuggerNotInErrorState;
RunToNextPauseNoInternal('', dcRun);
AssertDebuggerState(dsPause);
TestLocation('Init', 'BrkStart');
ThreadIdMain := dbg.Threads.CurrentThreads.CurrentThreadId;
StepInstrToNextLine('Go to AfterStep');
AssertDebuggerState(dsPause);
TestLocation('At AfterStep', 'AfterStep', -1);
StepInstrToNextLine('Go to AfterStepLongLine');
AssertDebuggerState(dsPause);
TestLocation('At AfterStepLongLine', 'AfterStepLongLine', -1);
StepInstrToNextLine('Go to AfterStepProc');
AssertDebuggerState(dsPause);
TestLocation('At AfterStepProc', 'AfterStepProc', -1);
StepInstrToNextLine('Go to AfterStepProcLong');
AssertDebuggerState(dsPause);
TestLocation('At AfterStepProcLong', 'AfterStepProcLong', -1);
StepInstrToNextLine('Go to AfterStepSleepProc');
AssertDebuggerState(dsPause);
TestLocation('At AfterStepSleepProc', 'AfterStepSleepProc', -1);
StepInstrToNextLine('Go to AfterStepSleep');
AssertDebuggerState(dsPause);
TestLocation('At AfterStepSleep', 'AfterStepSleep', -1);
StepInstrToNextLine('Go to AfterStepBrkDis');
AssertDebuggerState(dsPause);
TestLocation('At AfterStepBrkDis', 'AfterStepBrkDis', -1);
StepInstrToNextLine('Go to AfterStepBrkHitCnt', 0);
AssertDebuggerState(dsPause);
TestLocation('At AfterStepBrkHitCnt', 'AfterStepBrkHitCnt', -1);
TestEquals('No Hit for disabled break', 0, BrkDis.HitCount);
TestEquals('No Hit for skipped break', 1, BrkHitCnt.HitCount);
RunToNextPauseNoLoopBreak('', dcRun);
AssertDebuggerState(dsPause);
TestLocation('At BrkNested', 'BrkNested', -1);
StepInstrToNextLine('Go to AfterNested 1');
AssertDebuggerState(dsPause);
StepInstrToNextLine('Go to AfterNested 2');
AssertDebuggerState(dsPause);
TestLocation('At AfterNested', 'AfterNested', -1);
dbg.Stop;
finally
Debugger.FreeDebugger;
AssertTestErrors;
end;
end;
procedure TTestStepping.DoTestExceptionStepOutEx(
ANextOnlyStopOnStartLine: Boolean);
var
ExeName, TstName: String;
begin
ClearTestErrors;
FGotExceptCount := 0;
Src := GetCommonSourceFor(AppDir + 'ExceptTestPrg.pas');
TestCompile(Src, ExeName);
TestTrue('Start debugger', Debugger.StartDebugger(AppDir, ExeName));
dbg := Debugger.LazDebugger;
TFpDebugDebuggerProperties(dbg.GetProperties).NextOnlyStopOnStartLine := ANextOnlyStopOnStartLine;
try
dbg.Exceptions.Add('MyExceptionIgnore').Enabled := False;
dbg.OnException := @DoDebuggerException;
TstName := ' Run to Except';
FContinue := False;
RunToNextPauseNoInternal(TestName, dcRun);
TestEquals(TstName+': Got 1 exceptions: ', 1, FGotExceptCount);
// TestLocation(TstName+': CurLine ', 'BrkMyRaise', -1);
FContinue := True;
THookedFpDebugDebugger(dbg).LockRelCount := 0;
TstName := ' Step';
RunToNextPauseNoLoopBreak(TestName, dcStepOver);
TestLocation(TstName+': CurLine ', 'BrkStep3Fin_A', -1);
//TestLoopCount(TstName+': BrkStep3Fin_A');
RunToNextPauseNoLoopBreak(TestName, dcStepOut);
TestLocation(TstName+': CurLine ', 'BrkStep3FinOuter_A', -1);
//TestLoopCount(TstName+': BrkStep3FinOuter_A');
RunToNextPauseNoLoopBreak(TestName, dcStepOut);
TestLocation(TstName+': CurLine ', 'BrkStepMainExcept1', -1, 1);
//TestLoopCount(TstName+': BrkStepMainExcept1');
dbg.Stop;
finally
Debugger.FreeDebugger;
end;
AssertTestErrors;
end;
procedure TTestStepping.DoTestExceptionStepOverEx(
ANextOnlyStopOnStartLine: Boolean);
procedure ExpectEnterFinally(AName: String; ATestAppRecStep: Integer;
ATestIgnoreRaise, ATestRaiseSkipped, ATestStepOverNested: Boolean;
ATestIgnoreRaise_2, ATestRaiseSkipped_2, ATestStepOverNested_2: Boolean);
var
TstName: String;
MyRaiseBrk: TDBGBreakPoint;
begin
TstName := AName + ' Run to raise';
FGotExceptCount := 0;
FContinue := ATestIgnoreRaise or ATestStepOverNested;
if ATestStepOverNested then begin
// step to call line, starting on: Nop => TestVal => If ... then => call
RunToNextPauseNoInternal(TstName, dcStepOver);
RunToNextPauseNoInternal(TstName, dcStepOver);
RunToNextPauseNoInternal(TstName, dcStepOver);
// step is done by caller
// RunToNextPauseNoInternal(TstName, dcStepOver); // Step over recurse
//TestEquals(TstName+': Got 1 exceptions: ', 1, FGotExceptCount);
exit;
end
else
if ATestIgnoreRaise then begin
MyRaiseBrk := Debugger.SetBreakPoint(Src, 'BrkMyRaise');
RunToNextPauseNoInternal(TstName, dcRun);
MyRaiseBrk.ReleaseReference;
RunToNextPauseNoInternal(TstName, dcStepOver); // exception will be ignored => step to finally
TestEquals(TstName+': Got 1 exceptions: ', 1, FGotExceptCount);
end
else begin
RunToNextPauseNoInternal(TstName, dcRun);
TestEquals(TstName+': Got 1 exceptions: ', 1, FGotExceptCount);
// TODO: currently reports in except.inc
// TestLocation(TstName+': CurLine ', 'BrkMyRaise', -1);
RunToNextPauseNoInternal(TstName, dcStepOver);
end;
TstName := AName + ' Run to Finally A';
TestLocation(TstName+': CurLine ', 'BrkStep3Fin_A', -1);
if (ATestAppRecStep = 1) and (not ATestRaiseSkipped) then
ExpectEnterFinally(TstName+' INNER ', 0, ATestIgnoreRaise_2, ATestRaiseSkipped_2, ATestStepOverNested_2, False, False, False)
else
StepOverToLine(TstName, 'BrkStep3Fin_A_END', True);
TstName := AName + ' Run to Finally B';
RunToNextPauseNoInternal(TstName, dcStepOver); // Step to next finally
TestLocation(TstName+': CurLine ', 'BrkStep3Fin_B', -1);
//if (ATestAppRecStep = 2) and (not ATestRaiseSkipped) then
// ExpectEnterFinally(TstName+' INNER ', 0, ATestIgnoreRaise_2, ATestRaiseSkipped_2, ATestStepOverNested_2, False, False, False)
//else
StepOverToLine(TstName, 'BrkStep3Fin_B_END', True);
TstName := AName + ' Run to Finally C';
RunToNextPauseNoLoopBreak(TstName, dcStepOver); // Step to next finally
TestLocation(TstName+': CurLine ', 'BrkStep3Fin_C', -1);
if (ATestAppRecStep = 2) and (not ATestRaiseSkipped) then
ExpectEnterFinally(TstName+' INNER ', 0, ATestIgnoreRaise_2, ATestRaiseSkipped_2, ATestStepOverNested_2, False, False, False)
else
StepOverToLine(TstName, 'BrkStep3Fin_C_END', True);
TstName := AName + ' Run to Finally A(outer)';
RunToNextPauseNoLoopBreak(TstName, dcStepOver); // Step to next finally
//StepIfAtLine(TstName, 'BrkStep3Fin_IMPLICIT'); // 32 bit
//StepIfAtLine(TstName, 'BrkStep3Fin_IMPLICIT_1');
TestLocation(TstName+': CurLine ', 'BrkStep3FinOuter_A', -1);
if (ATestAppRecStep = 3) and (not ATestRaiseSkipped) then
ExpectEnterFinally(TstName+' INNER ', 0, ATestIgnoreRaise_2, ATestRaiseSkipped_2, ATestStepOverNested_2, False, False, False)
else
StepOverToLine(TstName, 'BrkStep3FinOuter_A_END', True);
TstName := AName + ' Run to Finally B(outer)';
RunToNextPauseNoLoopBreak(TstName, dcStepOver); // Step to next finally
TestLocation(TstName+': CurLine ', 'BrkStep3FinOuter_B', -1);
//if (ATestAppRecStep = 5) and (not ATestRaiseSkipped) then
// ExpectEnterFinally(TstName+' INNER ', 0, ATestIgnoreRaise_2, ATestRaiseSkipped_2, ATestStepOverNested_2, False, False, False)
//else
StepOverToLine(TstName, 'BrkStep3FinOuter_B_END', True);
TstName := AName + ' Run to Finally C(outer)';
RunToNextPauseNoLoopBreak(TstName, dcStepOver); // Step to next finally
TestLocation(TstName+': CurLine ', 'BrkStep3FinOuter_C', -1);
if (ATestAppRecStep = 4) and (not ATestRaiseSkipped) then
ExpectEnterFinally(TstName+' INNER ', 0, ATestIgnoreRaise_2, ATestRaiseSkipped_2, ATestStepOverNested_2, False, False, False)
else
StepOverToLine(TstName,'BrkStep3FinOuter_C_END', True);
end;
procedure ExpectNestedExcept(AName: String);
var
TstName: String;
begin
TstName := AName + ' Run to raise';
FGotExceptCount := 0;
FContinue := False;
RunToNextPauseNoLoopBreak(TstName, dcRun);
TestEquals(TstName+': Got 1 exceptions: ', 1, FGotExceptCount);
// TestLocation(TstName+': CurLine ', 'BrkMyRaise', -1);
TstName := AName + ' Run to except fin';
RunToNextPauseNoLoopBreak(TstName, dcStepOver); // Step to fin
TestLocation(TstName+': CurLine ', 'BrkStepNestedExcept_Finally', -1);
// NESTED
TstName := AName + ' Run to raise nested';
FGotExceptCount := 0;
FContinue := False;
RunToNextPauseNoLoopBreak(TstName, dcRun);
TestEquals(TstName+': Got 1 exceptions: ', 1, FGotExceptCount);
// TestLocation(TstName+': CurLine ', 'BrkMyRaise', -1);
TstName := AName + ' Run to except fin nested';
RunToNextPauseNoLoopBreak(TstName, dcStepOver); // Step to fin
TestLocation(TstName+': CurLine ', 'BrkStepNestedExcept_Finally', -1);
StepOverToLine(TstName,'BrkStepNestedExcept_Finally_END', True);
TstName := AName + ' Run to except nested';
RunToNextPauseNoLoopBreak(TstName, dcStepOver); // Step to next finally
TestLocation(TstName+': CurLine ', 'BrkStepNestedExcept', -1, 1);
StepOverToLine(TstName,'BrkStepNestedExcept_END', True);
// END NESTED
TstName := AName + ' Run back except fin';
RunToNextPauseNoLoopBreak(TstName, dcStepOver); // Step back to end
StepIfAtLine(TstName, 'BrkStepNestedExcept_TRY'); // may step to "try"
RunToNextPauseNoLoopBreak(TstName, dcStepOver); // Step back to finaly
//if not ANextOnlyStopOnStartLine then
// StepIfAtLine(TstName, 'BrkStepNestedExcept_Finally_BEFORE'); // TODO: XXXXX StepOver may stop at the step out line.
TestLocation(TstName+': CurLine ', 'BrkStepNestedExcept_Finally_AFTER', -1);
StepOverToLine(TstName,'BrkStepNestedExcept_Finally_END', True);
TstName := AName + ' Run to except';
RunToNextPauseNoLoopBreak(TstName, dcStepOver); // Step to next finally
TestLocation(TstName+': CurLine ', 'BrkStepNestedExcept', -1, 1);
RunToNextPauseNoLoopBreak(TstName, dcStepOut); // Step out
end;
procedure ExpectNestedExcept_Ignore(AName: String);
var
TstName: String;
begin
TstName := AName + ' Run to raise';
FGotExceptCount := 0;
FContinue := False;
RunToNextPauseNoLoopBreak(TstName, dcRun);
TestEquals(TstName+': Got 1 exceptions: ', 1, FGotExceptCount);
// TestLocation(TstName+': CurLine ', 'BrkMyRaise', -1);
TstName := AName + ' Run to except fin';
RunToNextPauseNoLoopBreak(TstName, dcStepOver); // Step to fin
TestLocation(TstName+': CurLine ', 'BrkStepNestedExcept_Finally', -1);
// NESTED
TstName := AName + ' Step over raise nested';
FGotExceptCount := 0;
FContinue := True;
StepOverToLine(TstName,'BrkStepNestedExcept_Finally_BEFORE', True);
RunToNextPauseNoInternal(TstName, dcStepOver);
TestEquals(TstName+': Got 1 exceptions: ', 1, FGotExceptCount);
TestLocation(TstName+': CurLine ', 'BrkStepNestedExcept_Finally_AFTER', -1);
StepOverToLine(TstName,'BrkStepNestedExcept_Finally_END', True);
TstName := AName + ' Run to except';
RunToNextPauseNoLoopBreak(TstName, dcStepOver); // Step to next finally
TestLocation(TstName+': CurLine ', 'BrkStepNestedExcept', -1, 1);
//StepOverToLine(TstName,'BrkStepNestedExcept_END', True);
RunToNextPauseNoLoopBreak(TstName, dcStepOut); // Step out
end;
var
ExeName, TstName, LName: String;
TestAppRecRaise, TestAppRecStep: Integer;
begin
ClearTestErrors;
Src := GetCommonSourceFor(AppDir + 'ExceptTestPrg.pas');
TestCompile(Src, ExeName);
TestTrue('Start debugger', Debugger.StartDebugger(AppDir, ExeName));
dbg := Debugger.LazDebugger;
TFpDebugDebuggerProperties(dbg.GetProperties).NextOnlyStopOnStartLine := ANextOnlyStopOnStartLine;
try
dbg.Exceptions.Add('MyExceptionIgnore').Enabled := False;
dbg.OnException := @DoDebuggerException;
(* RecRaise
0 : Step in => Raise nested except and debugger breaks at except, step to finally
1 : Step in => Raise nested except but debugger continues at except, step ends in finally
2 : Step in => do NOT raise nested except. Step through all the finally
3 : Step over => Raise nested except but debugger continues at except => nested finally NOT paused by debugger
*)
for TestAppRecRaise := 0 to 3 do
for TestAppRecStep := 0 to 4 do
if (TestAppRecRaise = 0) or (TestAppRecStep in [0,1,4]) then
begin
LName := Format('[RecRaise=%d / RecStep=%d] ', [TestAppRecRaise, TestAppRecStep]);
ExpectEnterFinally(LName, TestAppRecStep,
False, False, False,
TestAppRecRaise = 1, TestAppRecRaise = 2, TestAppRecRaise = 3);
TstName := LName + ' Run to Except (Main)';
RunToNextPauseNoInternal(TstName, dcStepOver); // Step to next finally
//StepIfAtLine(TstName, 'BrkStep3FinOuter_IMPLICIT'); // 32 bit
//StepIfAtLine(TstName, 'BrkStep3FinOuter_IMPLICIT_1');
TestLocation(TstName+': CurLine ', 'BrkStepMainExcept1', -1, 1);
TstName := LName + ' Step to After Except (Main)';
RunToNextPauseNoInternal(TstName, dcStepOver);
StepOverToLine(TstName,'BrkStepMainAfterExcept1', True);
TestLocation(TstName+': CurLine ', 'BrkStepMainAfterExcept1', -1);
end;
ExpectNestedExcept('Nested Except 1');
ExpectNestedExcept_Ignore('Nested Except Ignore');
dbg.Stop;
finally
Debugger.FreeDebugger;
end;
AssertTestErrors;
end;
procedure TTestStepping.DoTestStepTryBlocks(ANextOnlyStopOnStartLine: Boolean);
var NextCallAtName, NextTestAtName: String;
BrkAtCall, BrkInTest: TDBGBreakPoint;
procedure SetNextCallTo(ABrkName: String);
begin
NextCallAtName := ABrkName;
if BrkAtCall <> nil then begin
BrkAtCall.Enabled := False;
BrkAtCall.ReleaseReference;
end;
BrkAtCall := Debugger.SetBreakPoint(Src, ABrkName);
end;
function IsAtNextCallTo: Boolean;
begin
Result := IsAtLocation(NextCallAtName);
end;
procedure RunToNextCallTo(ATestName: String);
begin
if not IsAtNextCallTo then
RunToNextPauseEx(ATestName + ' (RunToNextCallTo) ', dcRun, NextCallAtName);
end;
procedure SetNextBreak(ABrkName: String);
begin
NextTestAtName := ABrkName;
if BrkInTest <> nil then begin
BrkInTest.Enabled := False;
BrkInTest.ReleaseReference;
end;
BrkInTest := Debugger.SetBreakPoint(Src, ABrkName);
end;
function IsAtNextBreak: Boolean;
begin
Result := IsAtLocation(NextTestAtName);
end;
function RunToNextBreak(ATestName: String): boolean;
begin
Result := IsAtNextBreak;
if not Result then
Result := RunToNextPauseEx(ATestName + ' (RunToNextBreakTo) ', dcRun, NextTestAtName);
end;
function MaybeStepMissingLine(TstName, AFirstBrkName, AFinalBrkName, IgnReason: String; AnUnwantedBrk: String = ''; ACmd1: TDBGCommand = dcStepOver; ACmd2: TDBGCommand = dcStepOver): boolean;
begin
FIgnoreReason := IgnReason + ' (Should go first to '+AFinalBrkName+' - But may directly go to '+AFinalBrkName+')';
Result := RunToNextPauseNoLoopBreak(TstName+'', ACmd1, AFirstBrkName);
FIgnoreReason := '';
if Result then begin
Result := RunToNextPauseNoLoopBreak(TstName+'', ACmd2, AFinalBrkName);
end
else begin
if AnUnwantedBrk <> '' then
FIgnoreReason := IgnReason + ' (Skipped desired first step to '+AFinalBrkName+' - May have hit undesired '+AnUnwantedBrk+')';
Result := TestLocation(TstName, AFinalBrkName, -1); // went directly to brk-2
FIgnoreReason := '';
if (AnUnwantedBrk <> '') and (not Result) and IsAtLocation(AnUnwantedBrk) then begin
FIgnoreReason := IgnReason + ' (Went to unwanted '+AnUnwantedBrk+' - May have skipped first hit at '+AFirstBrkName+')';
Result := RunToNextPauseNoLoopBreak(TstName+'', ACmd2, AFirstBrkName);
FIgnoreReason := '';
if (result) then
Result := RunToNextPauseNoLoopBreak(TstName+'', ACmd2, AFinalBrkName)
else
Result := TestLocation(TstName, AFinalBrkName, -1); // went directly to brk-2
end;
end;
end;
function MaybeStepUnWantedLine(TstName, AUnwantedBrkName, AFinalBrkName, IgnReason: String; ACmd: TDBGCommand = dcStepOver): boolean;
begin
FIgnoreReason := IgnReason + ' (Should go to '+AFinalBrkName+' - But may first hit '+AUnwantedBrkName+')';
Result := RunToNextPauseNoLoopBreak(TstName+'', ACmd, AFinalBrkName);
FIgnoreReason := '';
if Result then
exit;
TestLocation(TstName, AUnwantedBrkName, -1);
Result := RunToNextPauseNoLoopBreak(TstName+'', ACmd, AFinalBrkName); // try again
end;
function StepEnterTry_F(TstName, ATryBrkName, ANextBrk: String; ACmd1: TDBGCommand = dcStepOver; ACmd2: TDBGCommand = dcStepOver): boolean;
begin
Result := MaybeStepMissingLine(TstName, ATryBrkName, ANextBrk, '[Step-enter-try (try-finally)]', '', ACmd1, ACmd2);
// 3.2.0 and above may be fine
//Result := RunToNextPauseNoLoopBreak(TstName+'', dcStepOver, ATryBrkName);
//if Result then
//Result := RunToNextPauseNoLoopBreak(TstName+'', dcStepOver, ANextBrk);
end;
function StepEnterFinally(TstName, AFinallyBrkName, ANextBrk, ATryBrkName: String; ACmd1: TDBGCommand = dcStepOver; ACmd2: TDBGCommand = dcStepOver): boolean;
begin
Result := MaybeStepMissingLine(TstName, AFinallyBrkName, ANextBrk, '[Step-enter-finally]', {Unwanted:} ATryBrkName, ACmd1, ACmd2);
end;
function StepLeaveFinally(TstName, ANextBrk, ATryBrkName: String; ACmd: TDBGCommand = dcStepOver): boolean;
begin
Result := MaybeStepUnWantedLine(TstName, ATryBrkName, ANextBrk, '[Step-leave-finally]', ACmd);
//Result := RunToNextPauseNoLoopBreak(TstName, ACmd, ANextBrk);
end;
function StepEnterTry_E(TstName, ATryBrkName, ANextBrk: String; ACmd1: TDBGCommand = dcStepOver; ACmd2: TDBGCommand = dcStepOver): boolean;
begin
Result := MaybeStepMissingLine(TstName, ATryBrkName, ANextBrk, '[Step-enter-try (try-except)]', '', ACmd1, ACmd2);
end;
function StepLeaveTryNoExcept(TstName, ANextBrk, ATryBrkName: String; ACmd: TDBGCommand = dcStepOver): boolean;
begin
Result := MaybeStepUnWantedLine(TstName, ATryBrkName, ANextBrk, '[Step-leave-try (try-except)]', ACmd);
//Result := RunToNextPauseNoLoopBreak(TstName, ACmd, ANextBrk);
end;
procedure TestSimpleStepOver(TstName: String; ACmd: TDBGCommand = dcStepOver);
var
IsDone: Boolean;
begin
IsDone := False;
try
FIgnoreReason := '';
SetNextBreak('BEGIN');
if not RunToNextBreak(TstName) then exit;
// Enter TRY_A
if not RunToNextPauseNoLoopBreak(TstName+'', dcStepOver, 'TRY_A_1') then exit;
if not StepOverToLine(TstName+'', 'TRY_A_1_BEFORE_TRY_B', False, dcStepOver, 3) then exit;
// Enter TRY_B
if not StepEnterTry_F(TstName+'', 'TRY_B_1_EARLY', 'TRY_B_1', dcStepOver, ACmd) then exit;
if not RunToNextPauseNoLoopBreak(TstName+'', dcStepOver, 'TRY_B_1_BEFORE_TRY_C') then exit;
// Enter TRY_C
if not StepEnterTry_E(TstName+'', 'TRY_C_EARLY', 'TRY_C_1', dcStepOver, ACmd) then exit;
if not StepOverToLine(TstName+'', 'TRY_C_AFTER_RAISE_1', False, dcStepOver, 4) then exit;
if not RunToNextPauseNoLoopBreak(TstName+'', dcStepOver, 'TRY_C_BEFORE_EXCEPT_1') then exit;
// Leave TRY_C => back to TRY_B
if not StepLeaveTryNoExcept(TstName, 'TRY_B_AFTER_EXCEPT_1', 'TRY_C_EARLY') then exit;
if not StepOverToLine(TstName+'', 'TRY_B_BEFORE_FINALLY', False, dcStepOver, 5) then exit;
// Enter TRY_B_FINALLY
if not StepEnterFinally(TstName+'', 'TRY_B_FINALLY', 'TRY_B_FINALLY_1', 'TRY_B_1_EARLY', dcStepOver, ACmd) then exit;
if not StepOverToLine(TstName+'', 'TRY_B_FINALLY_END', False, dcStepOver, 2) then exit;
// Leave TRY_B => back to TRY_A
if not StepLeaveFinally(TstName, 'TRY_A_AFTER_FIN_B', 'TRY_B_1_EARLY') then exit;
if not RunToNextPauseNoLoopBreak(TstName+'', dcStepOver, 'TRY_A_BEFORE_FINALLY') then exit;
// Enter finally A
if not StepEnterFinally(TstName+'', 'TRY_A_FINALLY_EARLY', 'TRY_A_FINALLY_1', 'TRY_A_1', dcStepOver, ACmd) then exit;
// Enter TRY_D
if not StepOverToLine(TstName+'', 'TRY_D_1', False, dcStepOver, 3) then exit;
// Enter TRY_E
if not StepOverToLine(TstName+'', 'TRY_E_1', False, dcStepOver, 4) then exit;
if not StepOverToLine(TstName+'', 'TRY_E_BEFORE_FINALLY', False, dcStepOver, 3) then exit;
if not MaybeStepUnWantedLine(TstName, 'TRY_E_1', 'TRY_E_FINALLY_1', '[step-enter-finally-nop]') then exit;
// Enter TRY_F
if not StepOverToLine(TstName+'', 'TRY_F_1', False, dcStepOver, 4) then exit;
if not StepOverToLine(TstName+'', 'TRY_F_BEFORE_FINALLY', False, dcStepOver, 8) then exit;
// Enter finally_F
if not StepEnterFinally(TstName+'', 'TRY_F_FINALLY', 'TRY_F_FINALLY_1', 'TRY_F_1', dcStepOver, ACmd) then exit;
if not StepOverToLine(TstName+'', 'TRY_F_BEFORE_TRY_G', False, dcStepOver, 6) then exit;
// Enter TRY_G
if not RunToNextPauseNoLoopBreak(TstName+'', dcStepOver, 'TRY_G_1') then exit;
if not StepOverToLine(TstName+'', 'TRY_G_2', False, dcStepOver, 6) then exit;
if not StepEnterFinally(TstName+'', 'TRY_G_FINALLY', 'TRY_G_FINALLY_1', 'TRY_G_1', dcStepOver, ACmd) then exit;
if not StepOverToLine(TstName+'', 'TRY_G_FINALLY_END', False, dcStepOver, 4) then exit;
// LEAVE TRY_G => back to TRY F
if not StepLeaveFinally(TstName, 'TRY_F_FINALLY_AFTER_FIN_G', 'TRY_G_1') then exit;
if not StepOverToLine(TstName+'', 'TRY_F_FINALLY_END', False, dcStepOver, 3) then exit;
// LEAVE TRY_F => back to TRY E
if not StepLeaveFinally(TstName, 'TRY_E_FINALLY_AFTER_FIN_F', 'TRY_F_1') then exit;
if not StepOverToLine(TstName+'', 'TRY_E_FINALLY_END', False, dcStepOver, 3) then exit;
// LEAVE TRY_E => back to TRY A (skip except _D)
//if not StepLeaveFinally(TstName, 'TRY_A_FINALLY_AFTER_EXCEPT_D', 'TRY_E_1') then exit; // we can also hit the try for the EXCEPT block....
if not StepOverToLine(TstName, 'TRY_A_FINALLY_AFTER_EXCEPT_D', False, dcStepOver, 4) then exit;
if not StepOverToLine(TstName+'', 'TRY_A_FINALLY_END', False, dcStepOver, 3) then exit;
if not StepOverToLine(TstName+'', 'TRY_X_1', False, dcStepOver, 2) then exit;
if not StepEnterFinally(TstName+'', 'TRY_X_FINALLY', 'TRY_X_FINALLY_1', 'TRY_X_EARLY', dcStepOver, ACmd) then exit;
if not StepOverToLine(TstName+'', 'BEFORE_END', False, dcStepOver, 4) then exit;
if not RunToNextPauseNoLoopBreak(TstName+'', dcStepOver, 'END') then exit;
IsDone := True;
finally
TestTrue(TstName+' - DID NOT FINISH ALL TESTS', IsDone);
end;
end;
procedure TestSimpleRunAndStepOver(TstName: String; ACmd: TDBGCommand = dcStepOver);
(* Run into finally blocks, and see that step over behaves
*)
var
IsDone: Boolean;
begin
IsDone := False;
try
SetNextBreak('TRY_C_BEFORE_EXCEPT_1');
if not RunToNextBreak(TstName) then exit;
// Leave TRY_C => back to TRY_B
if not StepLeaveTryNoExcept(TstName, 'TRY_B_AFTER_EXCEPT_1', 'TRY_C_EARLY') then exit;
if not StepOverToLine(TstName+'', 'TRY_B_BEFORE_FINALLY', False, dcStepOver, 5) then exit;
// Enter TRY_B_FINALLY
if not StepEnterFinally(TstName+'', 'TRY_B_FINALLY', 'TRY_B_FINALLY_1', 'TRY_B_1_EARLY', dcStepOver, ACmd) then exit;
if not StepOverToLine(TstName+'', 'TRY_B_FINALLY_END', False, dcStepOver, 2) then exit;
SetNextBreak('TRY_F_BEFORE_TRY_G');
RunToNextBreak(TstName);
// Enter TRY_G
if not RunToNextPauseNoLoopBreak(TstName+'', dcStepOver, 'TRY_G_1') then exit;
if not StepOverToLine(TstName+'', 'TRY_G_2', False, dcStepOver, 6) then exit;
if not StepEnterFinally(TstName+'', 'TRY_G_FINALLY', 'TRY_G_FINALLY_1', 'TRY_G_1', dcStepOver, ACmd) then exit;
if not StepOverToLine(TstName+'', 'TRY_G_FINALLY_END', False, dcStepOver, 4) then exit;
// LEAVE TRY_G => back to TRY F
if not StepLeaveFinally(TstName, 'TRY_F_FINALLY_AFTER_FIN_G', 'TRY_G_1') then exit;
if not StepOverToLine(TstName+'', 'TRY_F_FINALLY_END', False, dcStepOver, 3) then exit;
// LEAVE TRY_F => back to TRY E
if not StepLeaveFinally(TstName, 'TRY_E_FINALLY_AFTER_FIN_F', 'TRY_F_1') then exit;
if not StepOverToLine(TstName+'', 'TRY_E_FINALLY_END', False, dcStepOver, 3) then exit;
// LEAVE TRY_E => back to TRY A (skip except _D)
//if not StepLeaveFinally(TstName, 'TRY_A_FINALLY_AFTER_EXCEPT_D', 'TRY_E_1') then exit; // we can also hit the try for the EXCEPT block....
if not StepOverToLine(TstName, 'TRY_A_FINALLY_AFTER_EXCEPT_D', False, dcStepOver, 4) then exit;
if not StepOverToLine(TstName+'', 'TRY_A_FINALLY_END', False, dcStepOver, 3) then exit;
IsDone := True;
finally
TestTrue(TstName+' - DID NOT FINISH ALL TESTS', IsDone);
end;
end;
procedure TestSimpleRunAndStepOverExit(TstName: String);
(* Run into finally blocks, and see that step over behaves
*)
var
IsDone: Boolean;
CurTstName: String;
begin
if (Compiler.Version < 030000) or
( (Compiler.CpuBitType = cpu32) and (Compiler.Version < 030200) )
then
exit;
IsDone := False;
try
CurTstName := TstName + ' exit 1 ';
SetNextBreak('TRY_F_3');
if not RunToNextBreak(CurTstName) then exit;
if not StepOverToLine(CurTstName+'', 'TRY_F_FINALLY', False, dcStepOver, 4, 'TRY_F_BEFORE_FINALLY') then exit;
if not RunToNextPauseNoLoopBreak(CurTstName+'', dcStepOver, 'TRY_F_FINALLY_1') then exit;
if not StepOverToLine(CurTstName+'', 'TRY_F_BEFORE_TRY_G', False, dcStepOver, 5) then exit;
if not StepOverToLine(CurTstName+'', 'TRY_G_1', False, dcStepOver, 2) then exit;
if not StepOverToLine(CurTstName+'', 'TRY_G_FINALLY', False, dcStepOver, 4) then exit;
if not StepOverToLine(CurTstName+'', 'TRY_F_FINALLY_END', False, dcStepOver, 8) then exit;
if not StepOverToLine(CurTstName+'', 'BAR1_RET', False, dcStepOver, 25, 'TRY_E_FINALLY_AFTER_FIN_F_2') then exit;
(*
CurTstName := TstName + ' exit 2 ';
SetNextBreak('TRY_F_FINALLY_1');
if not RunToNextBreak(CurTstName) then exit;
if not StepOverToLine(CurTstName+'', 'BAR1_RET', False, dcStepOver, 35, 'TRY_E_FINALLY_AFTER_FIN_F_2') then exit;
*)
IsDone := True;
finally
TestTrue(CurTstName+' - DID NOT FINISH ALL TESTS', IsDone);
end;
end;
procedure TestSimpleRunAndStepOut(TstName: String);
(* Run into finally blocks, and see that step over behaves
*)
var
IsDone: Boolean;
begin
IsDone := False;
try
SetNextBreak('TRY_C_BEFORE_EXCEPT_1');
if not RunToNextBreak(TstName) then exit;
RunToNextPauseNoLoopBreak(TstName+'', dcStepOut); // may end at BEGIN OR END
if not StepOverToLine(TstName+'', 'BAR2_RET', False, dcStepOver, 4, 'BEFORE_END') then exit;
if not StepOverToLine(TstName+'', 'BAR1_RET_FIN', False, dcStepOver, 4) then exit;
RunToNextPauseNoLoopBreak(TstName+'', dcStepOut); // may end at BEGIN OR END
if not StepOverToLine(TstName+'', 'FOO_RET', False, dcStepOver, 4) then exit;
SetNextBreak('TRY_F_BEFORE_TRY_G');
RunToNextBreak(TstName);
RunToNextPauseNoLoopBreak(TstName+'', dcStepOut); // may end at BEGIN OR END
if not StepOverToLine(TstName+'', 'BAR2_RET', False, dcStepOver, 4, 'BEFORE_END') then exit;
RunToNextPauseNoLoopBreak(TstName+'', dcStepOut); // may end at BEGIN OR END
if not StepOverToLine(TstName+'', 'FOO_RET', False, dcStepOver, 4) then exit;
IsDone := True;
finally
TestTrue(TstName+' - DID NOT FINISH ALL TESTS', IsDone);
end;
end;
var
ExeName: String;
begin
ClearTestErrors;
FGotExceptCount := 0;
FContinue := False;
BrkAtCall := nil;
BrkInTest := nil;
Src := GetCommonSourceFor(AppDir + 'StepTryBlocksPrg.pas');
TestCompile(Src, ExeName);
TestTrue('Start debugger', Debugger.StartDebugger(AppDir, ExeName));
dbg := Debugger.LazDebugger;
TFpDebugDebuggerProperties(dbg.GetProperties).NextOnlyStopOnStartLine := ANextOnlyStopOnStartLine;
try
dbg.OnException := @DoDebuggerException;
SetNextCallTo('CALL_TestSimpleStepOver');
RunToNextCallTo('');
SetNextCallTo('CALL_TestSimpleRunAndStepOver'); // catch any run-away - stop here
TestSimpleStepOver('Simple Step-Over: ');
if BrkInTest <> nil then BrkInTest.Enabled := False;
RunToNextCallTo('');
(* ONLY works if the compiler/RTL has no debug info / otherwise we correctly ?? step into the rtl *)
//SetNextCallTo('CALL_a');
//TestSimpleStepOver('Simple Step-Into: ', dcStepInto);
//RunToNextCallTo('');
SetNextCallTo('CALL_TestSimpleRunAndStepOverExit'); // catch any run-away - stop here
TestSimpleRunAndStepOver('TestSimpleRunAndStepOver: ');
if BrkInTest <> nil then BrkInTest.Enabled := False;
RunToNextCallTo('');
SetNextCallTo('CALL_TestSimpleRunAndStepOut'); // catch any run-away - stop here
TestSimpleRunAndStepOverExit('TestSimpleRunAndStepOverExit');
if BrkInTest <> nil then BrkInTest.Enabled := False;
RunToNextCallTo('');
SetNextCallTo('CALL_xx'); // catch any run-away - stop here
TestSimpleRunAndStepOut('TestSimpleRunAndStepOut: ');
if BrkInTest <> nil then BrkInTest.Enabled := False;
RunToNextCallTo('');
dbg.Stop;
finally
FIgnoreReason := '';
Debugger.FreeDebugger;
end;
AssertTestErrors;
end;
function TTestStepping.RunToNextPauseNoLoopBreak(AName: String;
ACmd: TDBGCommand; ATimeOut: Integer; AnExpAtBrkName: String;
AnExpAcceptLinesBefore: integer): Boolean;
begin
if AnExpAtBrkName <> '' then
AName := AName + ' (TO: '+AnExpAtBrkName+')';
THookedFpDebugDebugger(dbg).LockRelCount := 0;
Result := RunToNextPauseNoInternal(AName, ACmd, ATimeOut);
// LockRelease called in 2 * DoState / 1 * DebugLoopFinished
if not TestEquals(AName + ' ' + dbgs(ACmd)+' - lock cnt', 3, THookedFpDebugDebugger(dbg).LockRelCount)
then
Result := False;
if AnExpAtBrkName <> '' then
if not TestLocation(aName + ' ' + dbgs(ACmd)+': Finished at Line ', AnExpAtBrkName, -1, AnExpAcceptLinesBefore)
then
Result := False;
end;
function TTestStepping.RunToNextPauseNoLoopBreak(AName: String;
ACmd: TDBGCommand; AnExpAtBrkName: String; AnExpAcceptLinesBefore: integer
): Boolean;
begin
Result := RunToNextPauseNoLoopBreak(AName, ACmd, 5000, AnExpAtBrkName, AnExpAcceptLinesBefore);
end;
function TTestStepping.RunToNextPauseEx(AName: String; ACmd: TDBGCommand;
AnExpAtBrkName: String; AnExpAcceptLinesBefore: integer): Boolean;
begin
if AnExpAtBrkName <> '' then
AName := AName + ' (TO: '+AnExpAtBrkName+')';
Result := Debugger.RunToNextPause(ACmd);
if AnExpAtBrkName <> '' then
if not TestLocation(aName + ' ' + dbgs(ACmd)+': Finished at Line ', AnExpAtBrkName, -1, AnExpAcceptLinesBefore)
then
Result := False;
end;
initialization
RegisterDbgTest(TTestStepping);
ControlTest := TestControlRegisterTest('TTestStepping');
ControlTest_NextOnlyTrue := TestControlRegisterTest('TTestStepping_NextOnly=True', ControlTest);
ControlTestStepOver := TestControlRegisterTest('TTestStepOver', ControlTest_NextOnlyTrue);
ControlTestStepOverInstr := TestControlRegisterTest('TTestStepOverInstr', ControlTest_NextOnlyTrue);
ControlTestExceptionStepOutEx := TestControlRegisterTest('TTestExceptionStepOutEx', ControlTest_NextOnlyTrue);
ControlTestExceptionStepOverEx := TestControlRegisterTest('TTestExceptionStepOverEx', ControlTest_NextOnlyTrue);
ControlTestStepTryBlocks := TestControlRegisterTest('TTestStepTryBlocks', ControlTest_NextOnlyTrue);
ControlTest_NextOnly := TestControlRegisterTest('TTestStepping_NextOnly=False', ControlTest);
ControlTestStepOver_NextOnly := TestControlRegisterTest('TTestStepOver_NextOnly=False', ControlTest_NextOnly);
ControlTestStepOverInstr_NextOnly := TestControlRegisterTest('TTestStepOverInstr_NextOnly=False', ControlTest_NextOnly);
ControlTestExceptionStepOutEx_NextOnly := TestControlRegisterTest('TTestExceptionStepOutEx_NextOnly=False', ControlTest_NextOnly);
ControlTestExceptionStepOverEx_NextOnly := TestControlRegisterTest('TTestExceptionStepOverEx_NextOnly=False', ControlTest_NextOnly);
ControlTestStepTryBlocks_NextOnly := TestControlRegisterTest('TTestStepTryBlocks_NextOnly=False', ControlTest_NextOnly);
end.
Reference in New Issue View Git Blame Copy Permalink