From a2187cc1e3c8d3e658f10e2f70f8d19f42a5ae73 Mon Sep 17 00:00:00 2001 From: martin Date: Thu, 30 Nov 2017 15:59:50 +0000 Subject: [PATCH] Merged revision(s) 56243 #a43dd15a73, 56458 #41ae61a55c from trunk: GDBMI debugger: more tests for LineInfo with exceptions, run error, assert ........ gdebugger, gdbmi: fix stepping over exceptions - TESTS ........ git-svn-id: branches/fixes_1_8@56561 - --- .../test/TestApps/ExceptPrg.pas | 88 +++++++- .../lazdebuggergdbmi/test/TestGdbmi.lpi | 13 +- .../test/gdbmitestutils/gdbmitestutils.lpk | 15 +- .../test/gdbmitestutils/testbase.pas | 33 ++- .../lazdebuggergdbmi/test/testexception.pas | 202 +++++++++++++++++- 5 files changed, 324 insertions(+), 27 deletions(-) diff --git a/components/lazdebuggergdbmi/test/TestApps/ExceptPrg.pas b/components/lazdebuggergdbmi/test/TestApps/ExceptPrg.pas index c368cb9a6e..81b6401055 100644 --- a/components/lazdebuggergdbmi/test/TestApps/ExceptPrg.pas +++ b/components/lazdebuggergdbmi/test/TestApps/ExceptPrg.pas @@ -1,4 +1,4 @@ -program ExceptPrg; +program ExceptPrg; {$INLINE OFF} {$IFDEF TEST_WITH_HPLUS} {$H+} {$ELSE} @@ -35,12 +35,78 @@ var end; {$ENDIF} + {$IFDEF TEST_EXCEPTION_AT} + procedure Bar; + begin + raise Exception.create('at1') at + get_caller_addr(get_caller_frame(get_frame)), + get_caller_frame(get_caller_frame(get_frame)); + end; + + procedure Bar1; + begin + Bar(); + end; + + procedure Bar2; + begin + Bar1(); + end; + + procedure BarBar; + begin + raise Exception.create('at2') at + get_caller_addr(get_frame), + get_caller_frame(get_frame); + end; + + procedure BarBar1; + begin + BarBar(); + end; + + procedure BarBar2; + begin + BarBar1(); + end; + {$ENDIF} + + {$IFDEF TEST_RUNERR} + {$R+} + procedure Run; + var a: array of integer; + begin + SetLength(a, 2); + a[0] := -2; + a[1] := a[length(a)-a[0]]; + end; + + procedure Run1; + begin + Run(); + end; + {$ENDIF} + + {$IFDEF TEST_ASSERT} + {$C+} + procedure check; + begin + Assert(false, 'denied'); + end; + + procedure check1; + begin + check(); + end; + {$ENDIF} + begin {$IFnDEF TEST_NO_POINTER_VAR} p := nil; {$ENDIF} //foo; + {$IFnDEF TEST_SKIP_EXCEPTION_1} try {$IFnDEF TEST_NO_EXCEPTION_VAR} x := Exception.Create('foo'); @@ -59,8 +125,28 @@ begin end; end; writeln(1); + {$ENDIF} + + {$IFDEF TEST_EXCEPTION_AT} + try + Bar2(); + except end; + try + BarBar2(); + except end; + {$ENDIF} + + {$IFDEF TEST_RUNERR} + Run1(); + {$ENDIF} + + {$IFDEF TEST_ASSERT} + check1(); + {$ENDIF} + {$IFnDEF TEST_NO_EXCEPTION_TYPE} foo; {$ENDIF} + writeln(2); end. diff --git a/components/lazdebuggergdbmi/test/TestGdbmi.lpi b/components/lazdebuggergdbmi/test/TestGdbmi.lpi index 01179a2d4c..96d7675c6c 100644 --- a/components/lazdebuggergdbmi/test/TestGdbmi.lpi +++ b/components/lazdebuggergdbmi/test/TestGdbmi.lpi @@ -1,7 +1,7 @@ - + @@ -12,9 +12,6 @@ - - - @@ -53,7 +50,6 @@ - @@ -124,6 +120,9 @@ + + + @@ -132,11 +131,7 @@ - - - - diff --git a/components/lazdebuggergdbmi/test/gdbmitestutils/gdbmitestutils.lpk b/components/lazdebuggergdbmi/test/gdbmitestutils/gdbmitestutils.lpk index 523b427a5e..ff76025dfa 100644 --- a/components/lazdebuggergdbmi/test/gdbmitestutils/gdbmitestutils.lpk +++ b/components/lazdebuggergdbmi/test/gdbmitestutils/gdbmitestutils.lpk @@ -3,6 +3,7 @@ + @@ -10,12 +11,11 @@ - - - - - - + + + + + @@ -39,10 +39,9 @@ - + - diff --git a/components/lazdebuggergdbmi/test/gdbmitestutils/testbase.pas b/components/lazdebuggergdbmi/test/gdbmitestutils/testbase.pas index 471f864b30..4bf65f2473 100644 --- a/components/lazdebuggergdbmi/test/gdbmitestutils/testbase.pas +++ b/components/lazdebuggergdbmi/test/gdbmitestutils/testbase.pas @@ -6,7 +6,8 @@ interface uses Classes, SysUtils, FileUtil, fpcunit, testutils, testregistry, LCLProc, LazLogger, - LazFileUtils, DbgIntfDebuggerBase, CompileHelpers, Dialogs, TestGDBMIControl, GDBMIDebugger; // , FpGdbmiDebugger; + LazFileUtils, DbgIntfDebuggerBase, CompileHelpers, Dialogs, TestGDBMIControl, + RegExpr, GDBMIDebugger; // , FpGdbmiDebugger; // EnvironmentOpts, ExtToolDialog, TransferMacros, (* @@ -375,6 +376,10 @@ type procedure AddTestSuccess(s: string; MinGdbVers: Integer = 0; AIgnoreReason: String = ''); procedure AddTestSuccess(s: string; MinGdbVers: Integer; MinFpcVers: Integer;AIgnoreReason: String = ''); + function TestMatches(Expected, Got: string): Boolean; + function TestMatches(Name: string; Expected, Got: string; MinGdbVers: Integer = 0; AIgnoreReason: String = ''): Boolean; + function TestMatches(Name: string; Expected, Got: string; MinGdbVers: Integer; MinFpcVers: Integer; AIgnoreReason: String = ''): Boolean; + function TestEquals(Expected, Got: string): Boolean; function TestEquals(Name: string; Expected, Got: string; MinGdbVers: Integer = 0; AIgnoreReason: String = ''): Boolean; function TestEquals(Name: string; Expected, Got: string; MinGdbVers: Integer; MinFpcVers: Integer; AIgnoreReason: String = ''): Boolean; @@ -1066,6 +1071,32 @@ begin inc(FSucessCnt); end; +function TGDBTestCase.TestMatches(Expected, Got: string): Boolean; +begin + Result := TestMatches('', Expected, Got); +end; + +function TGDBTestCase.TestMatches(Name: string; Expected, Got: string; + MinGdbVers: Integer; AIgnoreReason: String): Boolean; +begin + Result := TestMatches(Name, Expected, Got, MinGdbVers, 0, AIgnoreReason); +end; + +function TGDBTestCase.TestMatches(Name: string; Expected, Got: string; + MinGdbVers: Integer; MinFpcVers: Integer; AIgnoreReason: String): Boolean; +var + rx: TRegExpr; +begin + rx := TRegExpr.Create; + rx.ModifierI := true; + rx.Expression := Expected; + Result := rx.Exec(Got); + FreeAndNil(rx); + if Result + then AddTestSuccess(Name + ': Expected to fail with, but succeded, Got "'+Got+'"', MinGdbVers, MinFpcVers, AIgnoreReason) + else AddTestError(Name + ': Expected "'+Expected+'", Got "'+Got+'"', MinGdbVers, MinFpcVers, AIgnoreReason); +end; + function TGDBTestCase.TestEquals(Expected, Got: string): Boolean; begin Result := TestEquals('', Expected, Got); diff --git a/components/lazdebuggergdbmi/test/testexception.pas b/components/lazdebuggergdbmi/test/testexception.pas index f2f1006b86..f6c853c143 100644 --- a/components/lazdebuggergdbmi/test/testexception.pas +++ b/components/lazdebuggergdbmi/test/testexception.pas @@ -21,6 +21,8 @@ type FGotExceptClass: String; FGotExceptMsg: String; FGotExceptType: TDBGExceptionType; + FGotExceptionLocation: TDBGLocationRec; + FContinue: Boolean; procedure DoDebuggerException(Sender: TObject; const AExceptionType: TDBGExceptionType; @@ -33,6 +35,7 @@ type published procedure TestException; procedure TestExceptionStepOut; + procedure TestExceptionStepOver; end; @@ -46,6 +49,16 @@ const BREAK_LINE_EXCEPT_4 = 50; // 3rd except BREAK_LINE_EXCEPT_END = 54; // line for break at end + STEP_OVER_RAISE_1 = 67; // first except / step over test + STEP_OVER_CATCH_1 = 68; // first except / step over test + STEP_OVER_RAISE_2 = 70; // first except / step over test + STEP_OVER_CATCH_2 = 71; // first except / step over test + STEP_OVER_RAISE_3 = 49; // first except / step over test + STEP_OVER_CATCH_3 = 53; // first except / step over test + STEP_OVER_RAISE_4 = 60; // first except / step over test + STEP_OVER_CATCH_4 = 81; // first except / step over test + + implementation //dbg.OnBreakPointHit := @DebuggerBreakPointHit; @@ -63,7 +76,8 @@ begin FGotExceptClass := AExceptionClass; FGotExceptMsg := AExceptionText; FGotExceptType := AExceptionType; - AContinue := False; + FGotExceptionLocation := AExceptionLocation; + AContinue := FContinue; end; procedure TTestExceptionOne.DoCurrent(Sender: TObject; const ALocation: TDBGLocationRec); @@ -79,26 +93,107 @@ var begin if SkipTest then exit; if not TestControlForm.CheckListBox1.Checked[TestControlForm.CheckListBox1.Items.IndexOf('TTestExceptionOne')] then exit; + if not TestControlForm.CheckListBox1.Checked[TestControlForm.CheckListBox1.Items.IndexOf(' TTestException')] then exit; ClearTestErrors; + FContinue := False; - TestCompile(AppDir + 'ExceptPrg.pas', TestExeName, '', '-gt -gh'); + TstName := 'All'; + TestCompile(AppDir + 'ExceptPrg.pas', TestExeName, '_raise_at', '-gt -gh -dTEST_EXCEPTION_AT'); try - FGotExceptCount := 0; TstName := 'all'; + FGotExceptCount := 0; dbg := StartGDB(AppDir, TestExeName); dbg.OnException := @DoDebuggerException; dbg.Run; - TestEquals(TstName+' Got 1 exception', 1, FGotExceptCount); + TstName := 'All - raise'; + TestEquals(TstName+' Got 1 exception', 1, FGotExceptCount); + TestEquals(TstName+' Got class', 'Exception', FGotExceptClass); + TestEquals(TstName+' Got msg', 'foo', FGotExceptMsg, 060000); + TestEquals(TstName+' Got location Line', 113, FGotExceptionLocation.SrcLine); + TestMatches(TstName+' Got location File', 'ExceptPrg\.pas$', FGotExceptionLocation.SrcFile); + TestMatches(TstName+' Got location Proc', '^main$', FGotExceptionLocation.FuncName); + TestTrue(TstName+' Got type', FGotExceptType = deInternal); + + dbg.Run; + TstName := 'All - raise at 2 down'; + TestEquals(TstName+' Got exception 2', 2, FGotExceptCount); TestEquals(TstName+' Got class', 'Exception', FGotExceptClass); - TestEquals(TstName+' Got msg', 'foo', FGotExceptMsg, 060000); + TestEquals(TstName+' Got msg', 'at1', FGotExceptMsg, 060000); + TestEquals(TstName+' Got location Line', 53, FGotExceptionLocation.SrcLine); + TestMatches(TstName+' Got location File', 'ExceptPrg\.pas$', FGotExceptionLocation.SrcFile); + TestMatches(TstName+' Got location Proc', '^Bar2$', FGotExceptionLocation.FuncName); + TestTrue(TstName+' Got type', FGotExceptType = deInternal); + dbg.Run; - TestEquals(TstName+' Got 2nd exception', 2, FGotExceptCount); + TstName := 'All - raise at 1 down'; + TestEquals(TstName+' Got exception 3', 3, FGotExceptCount); + TestEquals(TstName+' Got class', 'Exception', FGotExceptClass); + TestEquals(TstName+' Got msg', 'at2', FGotExceptMsg, 060000); + TestEquals(TstName+' Got location Line', 65, FGotExceptionLocation.SrcLine); + TestMatches(TstName+' Got location File', 'ExceptPrg\.pas$', FGotExceptionLocation.SrcFile); + TestMatches(TstName+' Got location Proc', '^BarBar1$', FGotExceptionLocation.FuncName); + TestTrue(TstName+' Got type', FGotExceptType = deInternal); + dbg.Run; - TestEquals(TstName+' Got no more exception', 2, FGotExceptCount); + TstName := 'All - raise subclass'; + TestEquals(TstName+'Got exception 4', 4, FGotExceptCount); TestEquals(TstName+' Got class', 'MyESome', FGotExceptClass); // not yet MakePrintable //TestEquals(TstName+' Got msg', 'abc üü {[''''[{ \n\t''#13#9''#', FGotExceptMsg, 050300); TestEquals(TstName+' Got msg', 'abc üü {[''[{ \n\t'#13#9'#', FGotExceptMsg, 050300); + TestEquals(TstName+' Got location Line', 34, FGotExceptionLocation.SrcLine); + TestMatches(TstName+' Got location File', 'ExceptPrg\.pas$', FGotExceptionLocation.SrcFile); + TestMatches(TstName+' Got location Proc', '^foo$', FGotExceptionLocation.FuncName); + TestTrue(TstName+' Got type', FGotExceptType = deInternal); + + dbg.Run; + TestEquals(TstName+' Got no more exception', 4, FGotExceptCount); + dbg.Stop; + finally + dbg.Done; + CleanGdb; + dbg.Free; + end; + + TstName := 'RunError'; + TestCompile(AppDir + 'ExceptPrg.pas', TestExeName, '_runerr', '-gt -gh -dTEST_SKIP_EXCEPTION_1 -dTEST_RUNERR'); + try + FGotExceptCount := 0; + dbg := StartGDB(AppDir, TestExeName); + dbg.OnException := @DoDebuggerException; + + dbg.Run; + TestEquals(TstName+' Got run err', 1, FGotExceptCount); + TestMatches(TstName+' Got class', 'RunError', FGotExceptClass); + //TestEquals(TstName+' Got msg', 'at2', FGotExceptMsg, 060000); + TestEquals(TstName+' Got location Line', 81, FGotExceptionLocation.SrcLine); + TestMatches(TstName+' Got location File', 'ExceptPrg\.pas$', FGotExceptionLocation.SrcFile); + TestMatches(TstName+' Got location Proc', '^Run$', FGotExceptionLocation.FuncName); + TestTrue(TstName+' Got type', FGotExceptType = deRunError); + + dbg.Stop; + finally + dbg.Done; + CleanGdb; + dbg.Free; + end; + + TstName := 'Assert'; + TestCompile(AppDir + 'ExceptPrg.pas', TestExeName, '_assert', '-gt -gh -dTEST_SKIP_EXCEPTION_1 -dTEST_ASSERT'); + try + FGotExceptCount := 0; + dbg := StartGDB(AppDir, TestExeName); + dbg.OnException := @DoDebuggerException; + + dbg.Run; + TestEquals(TstName+' Got Assert', 1, FGotExceptCount); + TestMatches(TstName+' Got class', 'EAssertionFailed', FGotExceptClass); + TestMatches(TstName+' Got msg', 'denied', FGotExceptMsg, 060000); +// TestEquals(TstName+' Got location Line', 94, FGotExceptionLocation.SrcLine); + TestMatches(TstName+' Got location File', 'ExceptPrg\.pas$', FGotExceptionLocation.SrcFile); +// TestMatches(TstName+' Got location Proc', '^check$', FGotExceptionLocation.FuncName); + TestTrue(TstName+' Got type', FGotExceptType = deInternal); + dbg.Stop; finally dbg.Done; @@ -245,7 +340,9 @@ var begin if SkipTest then exit; if not TestControlForm.CheckListBox1.Checked[TestControlForm.CheckListBox1.Items.IndexOf('TTestExceptionOne')] then exit; + if not TestControlForm.CheckListBox1.Checked[TestControlForm.CheckListBox1.Items.IndexOf(' TTestExceptionStepOut')] then exit; ClearTestErrors; + FContinue := False; TestCompile(AppDir + 'ExceptPrgStep.pas', TestExeName, '', ''); try @@ -305,9 +402,98 @@ begin AssertTestErrors; end; +procedure TTestExceptionOne.TestExceptionStepOver; +var + TestExeName, TstName: string; + dbg: TGDBMIDebugger; +begin + if SkipTest then exit; + if not TestControlForm.CheckListBox1.Checked[TestControlForm.CheckListBox1.Items.IndexOf('TTestExceptionOne')] then exit; + if not TestControlForm.CheckListBox1.Checked[TestControlForm.CheckListBox1.Items.IndexOf(' TTestExceptionStepOver')] then exit; + ClearTestErrors; + FContinue := True; + + TestCompile(AppDir + 'ExceptPrgStepOver.pas', TestExeName, '', ''); + try + FGotExceptCount := 0; TstName := 'STEPOVER '; + dbg := StartGDB(AppDir, TestExeName); + dbg.OnException := @DoDebuggerException; + dbg.OnCurrent := @DoCurrent; + + with dbg.BreakPoints.Add('ExceptPrgStepOver.pas', STEP_OVER_RAISE_1) do begin + InitialEnabled := True; + Enabled := True; + end; + with dbg.BreakPoints.Add('ExceptPrgStepOver.pas', STEP_OVER_RAISE_2) do begin + InitialEnabled := True; + Enabled := True; + end; + with dbg.BreakPoints.Add('ExceptPrgStepOver.pas', STEP_OVER_RAISE_3) do begin + InitialEnabled := True; + Enabled := True; + end; + with dbg.BreakPoints.Add('ExceptPrgStepOver.pas', STEP_OVER_RAISE_4) do begin + InitialEnabled := True; + Enabled := True; + end; + + dbg.Run; + TestEquals(TstName+' Before 1: Got 0 exceptions: ', 0, FGotExceptCount); + TestEquals(TstName+' Before 1: CurLine', STEP_OVER_RAISE_1, FCurLine); + + dbg.StepOver; + TestTrue(TstName+' (Stepped 1) at break '+IntToStr(FCurLine), + (FCurLine <= STEP_OVER_CATCH_1) and (FCurLine >= STEP_OVER_CATCH_1 - 2)); + TestEquals(TstName+' (Stepped 1) Got 1 exception', 1, FGotExceptCount); + + + + dbg.Run; + TestEquals(TstName+' Before 2: Got 1 exceptions: ', 1, FGotExceptCount); + TestEquals(TstName+' Before 2: CurLine', STEP_OVER_RAISE_2, FCurLine); + + dbg.StepOver; + TestTrue(TstName+' (Stepped 2) at break '+IntToStr(FCurLine), + (FCurLine <= STEP_OVER_CATCH_2) and (FCurLine >= STEP_OVER_CATCH_2 - 2)); + TestEquals(TstName+' (Stepped 2) Got 2 exception', 2, FGotExceptCount); + + + + dbg.Run; + TestEquals(TstName+' Before 3: Got 2 exceptions: ', 2, FGotExceptCount); + TestEquals(TstName+' Before 3: CurLine', STEP_OVER_RAISE_3, FCurLine); + + dbg.StepOver; + TestTrue(TstName+' (Stepped 3) at break '+IntToStr(FCurLine), + (FCurLine <= STEP_OVER_CATCH_3) and (FCurLine >= STEP_OVER_CATCH_3 - 2)); + TestEquals(TstName+' (Stepped 3) Got 3 exception', 3, FGotExceptCount); + + + + dbg.Run; + TestEquals(TstName+' Before 4: Got 3 exceptions: ', 3, FGotExceptCount); + TestEquals(TstName+' Before 4: CurLine', STEP_OVER_RAISE_4, FCurLine); + + dbg.StepOver; + TestTrue(TstName+' (Stepped 4) at break '+IntToStr(FCurLine), + (FCurLine <= STEP_OVER_CATCH_4) and (FCurLine >= STEP_OVER_CATCH_4 - 2)); + TestEquals(TstName+' (Stepped 4) Got 4 exception', 4, FGotExceptCount); + + + + dbg.Stop; + finally + dbg.Done; + CleanGdb; + dbg.Free; + end; + + AssertTestErrors; +end; + initialization RegisterDbgTest(TTestExceptionOne); - RegisterTestSelectors(['TTestExceptionOne' + RegisterTestSelectors(['TTestExceptionOne', ' TTestException', ' TTestExceptionStepOut', ' TTestExceptionStepOver' ]); end.