mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-05 23:58:06 +02:00
LazDebuggerFp: Test exception stepping
git-svn-id: trunk@62346 -
This commit is contained in:
martin
parent
a2a811c87c
commit
d70c65f807
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -2633,6 +2633,7 @@ components/lazdebuggers/lazdebuggerfp/test/fpclist.txt.sample svneol=native#text
|
||||
components/lazdebuggers/lazdebuggerfp/test/testapps/BreakPointPrg.pas svneol=native#text/pascal
|
||||
components/lazdebuggers/lazdebuggerfp/test/testapps/BreakPointThread2Prg.pas svneol=native#text/pascal
|
||||
components/lazdebuggers/lazdebuggerfp/test/testapps/BreakPointThreadPrg.pas svneol=native#text/pascal
|
||||
components/lazdebuggers/lazdebuggerfp/test/testapps/ExceptTestPrg.pas svneol=native#text/pascal
|
||||
components/lazdebuggers/lazdebuggerfp/test/testapps/StepOverPrg.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
|
||||
|
||||
@ -22,7 +22,6 @@
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<FormatVersion Value="2"/>
|
||||
<Modes Count="0"/>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="5">
|
||||
<Item1>
|
||||
|
||||
@ -6,7 +6,7 @@ uses
|
||||
{$IFDEF UNIX}
|
||||
cthreads,
|
||||
{$ENDIF}
|
||||
TestDbgControlForm, Interfaces, Forms, GuiTestRunner, TestVarious,
|
||||
TestDbgControlForm, Interfaces, Forms, GuiTestRunner, LazClasses, TestVarious,
|
||||
TestWatches, TestBase, TestBreakPoint, TestStepping;
|
||||
|
||||
{$R *.res}
|
||||
|
||||
@ -0,0 +1,214 @@
|
||||
program ExceptTestPrg;
|
||||
uses sysutils;
|
||||
|
||||
{off $DEFINE With_Implicit_Finally}
|
||||
|
||||
type
|
||||
MyExceptionIgnore = class(Exception) end;
|
||||
|
||||
var
|
||||
TestVal: integer;
|
||||
ControlRecurseStep3Outer, ControlRecurseRaise: Integer;
|
||||
|
||||
procedure Nop;
|
||||
begin
|
||||
Freemem(GetMem(1));
|
||||
end;
|
||||
|
||||
procedure MyRaise;
|
||||
begin
|
||||
if ControlRecurseRaise >= 0 then begin
|
||||
ControlRecurseRaise := 0;
|
||||
raise Exception.create('a'); // TEST_BREAKPOINT=BrkMyRaise
|
||||
end;
|
||||
|
||||
Freemem(GetMem(1));
|
||||
end;
|
||||
|
||||
procedure Step3Finally; forward;
|
||||
procedure Step3FinallyOuter; forward;
|
||||
|
||||
|
||||
procedure Step3FinallyOuterRecurse;
|
||||
begin
|
||||
ControlRecurseStep3Outer := 0; // only one recursion
|
||||
if ControlRecurseRaise > 0 then ControlRecurseRaise := -1;
|
||||
Step3FinallyOuter;
|
||||
end;
|
||||
|
||||
procedure Step3Finally;
|
||||
{$IFDEF With_Implicit_Finally}
|
||||
var
|
||||
a: Ansistring; // currently stepping into implicit finally handlers
|
||||
{$ENDIF}
|
||||
begin
|
||||
try
|
||||
try
|
||||
Nop;
|
||||
try
|
||||
Nop;
|
||||
{$IFDEF With_Implicit_Finally}
|
||||
a := 'a';
|
||||
{$ENDIF}
|
||||
MyRaise;
|
||||
Nop; // TEST_BREAKPOINT=BrkDeadCode3Fin
|
||||
|
||||
|
||||
finally
|
||||
Nop; // TEST_BREAKPOINT=BrkStep3Fin_A
|
||||
{$IFDEF With_Implicit_Finally}
|
||||
a := a + 'b';
|
||||
{$ENDIF}
|
||||
TestVal := TestVal + 1;
|
||||
if ControlRecurseStep3Outer = 1 then
|
||||
Step3FinallyOuterRecurse;
|
||||
nop; end; // TEST_BREAKPOINT=BrkStep3Fin_A_END
|
||||
|
||||
|
||||
finally
|
||||
Nop; // TEST_BREAKPOINT=BrkStep3Fin_B
|
||||
TestVal := TestVal + 1;
|
||||
//if ControlRecurseStep3Outer = XXX then
|
||||
// Step3FinallyOuterRecurse;
|
||||
nop; end; // TEST_BREAKPOINT=BrkStep3Fin_B_END
|
||||
|
||||
|
||||
finally
|
||||
Nop; // TEST_BREAKPOINT=BrkStep3Fin_C
|
||||
TestVal := TestVal + 1;
|
||||
if ControlRecurseStep3Outer = 2 then
|
||||
Step3FinallyOuterRecurse;
|
||||
nop; end; // TEST_BREAKPOINT=BrkStep3Fin_C_END
|
||||
|
||||
|
||||
Nop; // TEST_BREAKPOINT=BrkStep3Fin_Body
|
||||
Nop;
|
||||
Nop; // TEST_BREAKPOINT=BrkStep3Fin_IMPLICIT
|
||||
end; // TEST_BREAKPOINT=BrkStep3Fin_IMPLICIT_1
|
||||
|
||||
procedure Step3FinallyOuter;
|
||||
{$IFDEF With_Implicit_Finally}
|
||||
var
|
||||
a: Ansistring;
|
||||
{$ENDIF}
|
||||
begin
|
||||
try
|
||||
try
|
||||
Nop;
|
||||
try
|
||||
Nop;
|
||||
{$IFDEF With_Implicit_Finally}
|
||||
a := 'a';
|
||||
{$ENDIF}
|
||||
Step3Finally;
|
||||
Nop; // TEST_BREAKPOINT=BrkDeadCode3FinOuter
|
||||
|
||||
|
||||
finally
|
||||
Nop; // TEST_BREAKPOINT=BrkStep3FinOuter_A
|
||||
{$IFDEF With_Implicit_Finally}
|
||||
a := a + 'b';
|
||||
{$ENDIF}
|
||||
TestVal := TestVal + 1;
|
||||
if ControlRecurseStep3Outer = 3 then
|
||||
Step3FinallyOuterRecurse;
|
||||
nop; end; // TEST_BREAKPOINT=BrkStep3FinOuter_A_END
|
||||
|
||||
|
||||
finally
|
||||
Nop; // TEST_BREAKPOINT=BrkStep3FinOuter_B
|
||||
TestVal := TestVal + 1;
|
||||
//if ControlRecurseStep3Outer = XXX then
|
||||
// Step3FinallyOuterRecurse;
|
||||
nop; end; // TEST_BREAKPOINT=BrkStep3FinOuter_B_END
|
||||
|
||||
|
||||
finally
|
||||
Nop; // TEST_BREAKPOINT=BrkStep3FinOuter_C
|
||||
TestVal := TestVal + 1;
|
||||
if ControlRecurseStep3Outer = 4 then
|
||||
Step3FinallyOuterRecurse;
|
||||
nop; end; // TEST_BREAKPOINT=BrkStep3FinOuter_C_END
|
||||
|
||||
|
||||
Nop; // TEST_BREAKPOINT=BrkStep3FinOuter_IMPLICIT
|
||||
end; // TEST_BREAKPOINT=BrkStep3FinOuter_IMPLICIT_1
|
||||
|
||||
procedure NestedExcept(a: integer = 0);
|
||||
begin
|
||||
try // TEST_BREAKPOINT=BrkStepNestedExcept_TRY
|
||||
try
|
||||
MyRaise;
|
||||
nop; // TEST_BREAKPOINT=BrkStepNestedExcept_DEAD
|
||||
|
||||
finally
|
||||
nop; // TEST_BREAKPOINT=BrkStepNestedExcept_Finally
|
||||
nop;
|
||||
if a = 0 then
|
||||
NestedExcept(1); // TEST_BREAKPOINT=BrkStepNestedExcept_Finally_BEFORE
|
||||
nop; // TEST_BREAKPOINT=BrkStepNestedExcept_Finally_AFTER
|
||||
nop;
|
||||
nop; end; // TEST_BREAKPOINT=BrkStepNestedExcept_Finally_END
|
||||
|
||||
nop; except // some fpc versions put debug line for except, at the end of previous statement
|
||||
nop; // TEST_BREAKPOINT=BrkStepNestedExcept
|
||||
nop;
|
||||
nop; end; // TEST_BREAKPOINT=BrkStepNestedExcept_END
|
||||
|
||||
end;
|
||||
|
||||
var
|
||||
RecStep, RecRaise: Integer;
|
||||
begin
|
||||
(* 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 RecRaise := 0 to 3 do // ignore or break at recurse
|
||||
for RecStep := 0 to 4 do
|
||||
if (RecRaise = 0) or (RecStep in [0,1,4]) then
|
||||
begin
|
||||
try
|
||||
ControlRecurseStep3Outer := RecStep;
|
||||
ControlRecurseRaise := 0;
|
||||
if RecRaise = 2 then
|
||||
ControlRecurseRaise := 1; // do not raise in recurse, but enter all the finally without stopping
|
||||
TestVal := 1;
|
||||
Step3FinallyOuter;
|
||||
nop; // TEST_BREAKPOINT=BrkMainDeadCode1
|
||||
|
||||
|
||||
nop; except // some fpc versions put debug line for except, at the end of previous statement
|
||||
nop; // TEST_BREAKPOINT=BrkStepMainExcept1
|
||||
nop;
|
||||
TestVal := TestVal + 1;
|
||||
end;
|
||||
|
||||
|
||||
Nop; // TEST_BREAKPOINT=BrkStepMainAfterExcept1
|
||||
end;
|
||||
|
||||
ControlRecurseRaise := 0;
|
||||
NestedExcept;
|
||||
Nop;
|
||||
|
||||
ControlRecurseRaise := 0;
|
||||
NestedExcept;
|
||||
Nop;
|
||||
|
||||
|
||||
// Do NOT step to finally, but set a breakpoint in it. Then step to next finally
|
||||
nop;
|
||||
nop; // TEST_BREAKPOINT=BrkMain1
|
||||
ControlRecurseStep3Outer := 0;
|
||||
ControlRecurseRaise := 0;
|
||||
TestVal := 1;
|
||||
try
|
||||
Step3FinallyOuter;
|
||||
except
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
@ -17,8 +17,24 @@ type
|
||||
protected
|
||||
Src: TCommonSource;
|
||||
Dbg: TDebuggerIntf;
|
||||
procedure TestLocation(ATestName, ABrkName: String; ABreakHitCount: Integer = 1); // only line-number
|
||||
function IsAtLocation(ABrkName: String): Boolean; // only line-number
|
||||
|
||||
FGotExceptCount: Integer;
|
||||
FGotExceptClass: String;
|
||||
FGotExceptMsg: String;
|
||||
FGotExceptType: TDBGExceptionType;
|
||||
FGotExceptionLocation: TDBGLocationRec;
|
||||
FContinue: Boolean;
|
||||
|
||||
procedure TestLocation(ATestName, ABrkName: String; ABreakHitCount: Integer = 1; AnAcceptLinesBefore: integer = 0); // only line-number
|
||||
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): Boolean;
|
||||
function StepIfAtLine(ATestName, ABrkName: String): Boolean;
|
||||
published
|
||||
(* Step over to work with various events happening during the step
|
||||
- creation/exit of threads
|
||||
@ -28,33 +44,89 @@ type
|
||||
*)
|
||||
procedure TestStepOver;
|
||||
procedure TestStepOverInstr;
|
||||
procedure TestExceptionStepOutEx;
|
||||
procedure TestExceptionStepOverEx;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
var
|
||||
ControlTest, ControlTestStepOver, ControlTestStepOverInstr: Pointer;
|
||||
ControlTest, ControlTestStepOver, ControlTestStepOverInstr,
|
||||
ControlTestExceptionStepOutEx, ControlTestExceptionStepOverEx: Pointer;
|
||||
|
||||
procedure TTestStepping.TestLocation(ATestName, ABrkName: String;
|
||||
ABreakHitCount: Integer);
|
||||
ABreakHitCount: Integer; AnAcceptLinesBefore: integer);
|
||||
var
|
||||
lc: TDBGLocationRec;
|
||||
brk: LongInt;
|
||||
begin
|
||||
AssertDebuggerState(dsPause);
|
||||
lc := Debugger.LazDebugger.GetLocation;
|
||||
TestEquals(ATestName+' '+ABrkName+' Loc', Src.BreakPoints[ABrkName], lc.SrcLine);
|
||||
brk := Src.BreakPoints[ABrkName];
|
||||
if (AnAcceptLinesBefore > 0) and (lc.SrcLine < brk) and (lc.SrcLine >= brk - AnAcceptLinesBefore)
|
||||
then
|
||||
TestEquals(ATestName+' '+ABrkName+' Loc', brk, lc.SrcLine, 0, 'Ignored - In AcceptLinesBefore range')
|
||||
else
|
||||
TestEquals(ATestName+' '+ABrkName+' Loc', brk, lc.SrcLine);
|
||||
if ABreakHitCount >= 0 then
|
||||
TestEquals(ATestName+' '+ABrkName+' HitCnt', Debugger.BreakPointByName(ABrkName).HitCount, ABreakHitCount);
|
||||
end;
|
||||
|
||||
function TTestStepping.IsAtLocation(ABrkName: String): Boolean;
|
||||
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): Boolean;
|
||||
var
|
||||
mx: Integer;
|
||||
begin
|
||||
mx := 100; // max steps
|
||||
Result := True;
|
||||
while not IsAtLocation(ABrkName, AnExitIfNoLineInfo) do begin
|
||||
Debugger.RunToNextPause(dcStepOver);
|
||||
AssertDebuggerState(dsPause, ATestName);
|
||||
dec(mx);
|
||||
if mx = 0 then begin
|
||||
TestTrue(ATestName+'reached step target '+ ABrkName, False);
|
||||
Result := False;
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
debugln(['XXXXXXXXXXXXXXXXXXXXXXXX to ', ABrkName, ' ',ATestName]);
|
||||
end;
|
||||
|
||||
function TTestStepping.StepIfAtLine(ATestName, ABrkName: String): Boolean;
|
||||
begin
|
||||
Result := True;
|
||||
if not IsAtLocation(ABrkName) then
|
||||
exit;
|
||||
Debugger.RunToNextPause(dcStepOver);
|
||||
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]);
|
||||
end;
|
||||
|
||||
procedure TTestStepping.TestStepOver;
|
||||
var
|
||||
ExeName: String;
|
||||
@ -184,7 +256,6 @@ begin
|
||||
|
||||
dbg.Stop;
|
||||
finally
|
||||
Debugger.ClearDebuggerMonitors;
|
||||
Debugger.FreeDebugger;
|
||||
|
||||
AssertTestErrors;
|
||||
@ -284,13 +355,291 @@ begin
|
||||
|
||||
dbg.Stop;
|
||||
finally
|
||||
Debugger.ClearDebuggerMonitors;
|
||||
Debugger.FreeDebugger;
|
||||
|
||||
AssertTestErrors;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestStepping.TestExceptionStepOutEx;
|
||||
var
|
||||
ExeName, TstName: String;
|
||||
begin
|
||||
if SkipTest then exit;
|
||||
if not TestControlCanTest(ControlTestExceptionStepOutEx) then exit;
|
||||
ClearTestErrors;
|
||||
|
||||
Src := GetCommonSourceFor(AppDir + 'ExceptTestPrg.pas');
|
||||
TestCompile(Src, ExeName);
|
||||
|
||||
TestTrue('Start debugger', Debugger.StartDebugger(AppDir, ExeName));
|
||||
dbg := Debugger.LazDebugger;
|
||||
try
|
||||
dbg.Exceptions.Add('MyExceptionIgnore').Enabled := False;
|
||||
dbg.OnException := @DoDebuggerException;
|
||||
|
||||
TstName := ' Run to Except';
|
||||
FContinue := False;
|
||||
Debugger.RunToNextPause(dcRun);
|
||||
TestEquals(TstName+': Got 1 exceptions: ', 1, FGotExceptCount);
|
||||
// TestLocation(TstName+': CurLine ', 'BrkMyRaise', -1);
|
||||
FContinue := True;
|
||||
|
||||
TstName := ' Step';
|
||||
Debugger.RunToNextPause(dcStepOver);
|
||||
TestLocation(TstName+': CurLine ', 'BrkStep3Fin_A', -1);
|
||||
|
||||
Debugger.RunToNextPause(dcStepOut);
|
||||
TestLocation(TstName+': CurLine ', 'BrkStep3FinOuter_A', -1);
|
||||
|
||||
Debugger.RunToNextPause(dcStepOut);
|
||||
TestLocation(TstName+': CurLine ', 'BrkStepMainExcept1', -1, 1);
|
||||
|
||||
|
||||
dbg.Stop;
|
||||
finally
|
||||
Debugger.FreeDebugger;
|
||||
end;
|
||||
|
||||
AssertTestErrors;
|
||||
end;
|
||||
|
||||
procedure TTestStepping.TestExceptionStepOverEx;
|
||||
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
|
||||
Debugger.RunToNextPause(dcStepOver);
|
||||
Debugger.RunToNextPause(dcStepOver);
|
||||
Debugger.RunToNextPause(dcStepOver);
|
||||
// step is done by caller
|
||||
// Debugger.RunToNextPause(dcStepOver); // Step over recurse
|
||||
//TestEquals(TstName+': Got 1 exceptions: ', 1, FGotExceptCount);
|
||||
exit;
|
||||
end
|
||||
else
|
||||
if ATestIgnoreRaise then begin
|
||||
MyRaiseBrk := Debugger.SetBreakPoint(Src, 'BrkMyRaise');
|
||||
Debugger.RunToNextPause(dcRun);
|
||||
MyRaiseBrk.ReleaseReference;
|
||||
Debugger.RunToNextPause(dcStepOver); // exception will be ignored => step to finally
|
||||
TestEquals(TstName+': Got 1 exceptions: ', 1, FGotExceptCount);
|
||||
end
|
||||
else begin
|
||||
Debugger.RunToNextPause(dcRun);
|
||||
TestEquals(TstName+': Got 1 exceptions: ', 1, FGotExceptCount);
|
||||
// TODO: currently reports in except.inc
|
||||
// TestLocation(TstName+': CurLine ', 'BrkMyRaise', -1);
|
||||
Debugger.RunToNextPause(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';
|
||||
Debugger.RunToNextPause(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';
|
||||
Debugger.RunToNextPause(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)';
|
||||
Debugger.RunToNextPause(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)';
|
||||
Debugger.RunToNextPause(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)';
|
||||
Debugger.RunToNextPause(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;
|
||||
Debugger.RunToNextPause(dcRun);
|
||||
TestEquals(TstName+': Got 1 exceptions: ', 1, FGotExceptCount);
|
||||
// TestLocation(TstName+': CurLine ', 'BrkMyRaise', -1);
|
||||
|
||||
TstName := AName + ' Run to except fin';
|
||||
Debugger.RunToNextPause(dcStepOver); // Step to fin
|
||||
TestLocation(TstName+': CurLine ', 'BrkStepNestedExcept_Finally', -1);
|
||||
|
||||
// NESTED
|
||||
TstName := AName + ' Run to raise nested';
|
||||
FGotExceptCount := 0;
|
||||
FContinue := False;
|
||||
Debugger.RunToNextPause(dcRun);
|
||||
TestEquals(TstName+': Got 1 exceptions: ', 1, FGotExceptCount);
|
||||
// TestLocation(TstName+': CurLine ', 'BrkMyRaise', -1);
|
||||
|
||||
TstName := AName + ' Run to except fin nested';
|
||||
Debugger.RunToNextPause(dcStepOver); // Step to fin
|
||||
TestLocation(TstName+': CurLine ', 'BrkStepNestedExcept_Finally', -1);
|
||||
|
||||
StepOverToLine(TstName,'BrkStepNestedExcept_Finally_END', True);
|
||||
|
||||
TstName := AName + ' Run to except nested';
|
||||
Debugger.RunToNextPause(dcStepOver); // Step to next finally
|
||||
TestLocation(TstName+': CurLine ', 'BrkStepNestedExcept', -1, 1);
|
||||
|
||||
StepOverToLine(TstName,'BrkStepNestedExcept_END', True);
|
||||
// END NESTED
|
||||
|
||||
TstName := AName + ' Run back except fin';
|
||||
Debugger.RunToNextPause(dcStepOver); // Step back to end
|
||||
StepIfAtLine(TstName, 'BrkStepNestedExcept_TRY'); // may step to "try"
|
||||
Debugger.RunToNextPause(dcStepOver); // Step back to finaly
|
||||
TestLocation(TstName+': CurLine ', 'BrkStepNestedExcept_Finally_AFTER', -1);
|
||||
|
||||
StepOverToLine(TstName,'BrkStepNestedExcept_Finally_END', True);
|
||||
|
||||
TstName := AName + ' Run to except';
|
||||
Debugger.RunToNextPause(dcStepOver); // Step to next finally
|
||||
TestLocation(TstName+': CurLine ', 'BrkStepNestedExcept', -1, 1);
|
||||
|
||||
Debugger.RunToNextPause(dcStepOut); // Step out
|
||||
end;
|
||||
|
||||
procedure ExpectNestedExcept_Ignore(AName: String);
|
||||
var
|
||||
TstName: String;
|
||||
begin
|
||||
TstName := AName + ' Run to raise';
|
||||
FGotExceptCount := 0;
|
||||
FContinue := False;
|
||||
Debugger.RunToNextPause(dcRun);
|
||||
TestEquals(TstName+': Got 1 exceptions: ', 1, FGotExceptCount);
|
||||
// TestLocation(TstName+': CurLine ', 'BrkMyRaise', -1);
|
||||
|
||||
TstName := AName + ' Run to except fin';
|
||||
Debugger.RunToNextPause(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);
|
||||
Debugger.RunToNextPause(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';
|
||||
Debugger.RunToNextPause(dcStepOver); // Step to next finally
|
||||
TestLocation(TstName+': CurLine ', 'BrkStepNestedExcept', -1, 1);
|
||||
|
||||
//StepOverToLine(TstName,'BrkStepNestedExcept_END', True);
|
||||
Debugger.RunToNextPause(dcStepOut); // Step out
|
||||
|
||||
end;
|
||||
|
||||
var
|
||||
ExeName, TstName, LName: String;
|
||||
TestAppRecRaise, TestAppRecStep: Integer;
|
||||
begin
|
||||
if SkipTest then exit;
|
||||
if not TestControlCanTest(ControlTestExceptionStepOverEx) then exit;
|
||||
ClearTestErrors;
|
||||
|
||||
Src := GetCommonSourceFor(AppDir + 'ExceptTestPrg.pas');
|
||||
TestCompile(Src, ExeName);
|
||||
|
||||
TestTrue('Start debugger', Debugger.StartDebugger(AppDir, ExeName));
|
||||
dbg := Debugger.LazDebugger;
|
||||
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)';
|
||||
Debugger.RunToNextPause(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)';
|
||||
Debugger.RunToNextPause(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;
|
||||
|
||||
|
||||
initialization
|
||||
|
||||
@ -298,5 +647,7 @@ initialization
|
||||
ControlTest := TestControlRegisterTest('TTestStepping');
|
||||
ControlTestStepOver := TestControlRegisterTest('TTestStepOver', ControlTest);
|
||||
ControlTestStepOverInstr := TestControlRegisterTest('TTestStepOverInstr', ControlTest);
|
||||
ControlTestExceptionStepOutEx := TestControlRegisterTest('TTestExceptionStepOutEx', ControlTest);
|
||||
ControlTestExceptionStepOverEx := TestControlRegisterTest('TTestExceptionStepOverEx', ControlTest);
|
||||
end.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user