unit TestException;

{$mode objfpc}{$H+}

interface

uses
  Classes, sysutils, fpcunit, testutils, testregistry, TestBase, GDBMIDebugger,
  LCLProc, DbgIntfDebuggerBase, TestDbgControl, TestDbgTestSuites,
  TestDbgConfig, TestCommonSources, TestOutputLogger;

type

  { TTestExceptionOne }

  TTestExceptionOne = class(TGDBTestCase)
  private
    Src: TCommonSource;

    FCurLine: Integer;
    FCurFile: string;

    FGotExceptCount: Integer;
    FGotExceptClass: String;
    FGotExceptMsg: String;
    FGotExceptType: TDBGExceptionType;
    FGotExceptionLocation: TDBGLocationRec;
    FContinue: Boolean;

    procedure DoDebuggerException(Sender: TObject;
                                  const AExceptionType: TDBGExceptionType;
                                  const AExceptionClass: String;
                                  const AExceptionLocation: TDBGLocationRec;
                                  const AExceptionText: String;
                                  out AContinue: Boolean);
  protected
    FInternalExceptionBrkSetMethod: TInternBrkSetMethod;

    function GetLogFileName: String; override;
    procedure DoCurrent(Sender: TObject; const ALocation: TDBGLocationRec);
    procedure TestLocation(ATestName, ABrkName: String; AnAllowLineBefore: Integer = 0; AnAltBrkName: String = '');
    function  IsAtLine(ABrkName: String; ATrueOnNoLine: Boolean = False): Boolean;
    function StepOverToLine(ATestName, ABrkName: String; AnExitIfNoLineInfo: Boolean = False): Boolean;
    function StepOverLeaveFinally(ATestName: String): Boolean;
  published
    procedure TestException;
    procedure TestExceptionStepOut;
    procedure TestExceptionStepOver;
    procedure TestExceptionStepOutEx; // Extended for SEH
    procedure TestExceptionStepOverEx; // Extended for SEH
  end;

  { TTestExceptionAddrDirect }

  TTestExceptionAddrDirect = class(TTestExceptionOne)
  public
    constructor Create; override;
  end;

  { TTestExceptionAddrInDirect }

  TTestExceptionAddrInDirect = class(TTestExceptionOne)
  public
    constructor Create; override;
  end;

  { TTestExceptionForceName }

  TTestExceptionForceName = class(TTestExceptionOne)
  public
    constructor Create; override;
  end;


const
  (* Stepping out of the exception may currently stop one line before the "except statemet.
     The lines below are the first line in the statement. (so 2 later)
  *)
  BREAK_LINE_EXCEPT_1 = 20;  // first except blog // may be 18 = at "except" keyword
  BREAK_LINE_EXCEPT_2 = 31;  // 2nd except
  BREAK_LINE_EXCEPT_3 = 45;  // 3rd except not handled
  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
var
  ControlTestExceptionOne, ControlTestExceptionOneException,
  ControlTestExceptionOneExceptionStepOut, ControlTestExceptionOneExceptionStepOver,
  ControlTestExceptionOneExceptionStepOutEx, ControlTestExceptionOneExceptionStepOverEx: Pointer;

{ TTestExceptionForceName }

constructor TTestExceptionForceName.Create;
begin
  FInternalExceptionBrkSetMethod := ibmName;
  inherited Create;
end;

{ TTestExceptionAddrInDirect }

constructor TTestExceptionAddrInDirect.Create;
begin
  FInternalExceptionBrkSetMethod := ibmAddrIndirect;
  inherited Create;
end;

{ TTestExceptionAddrDirect }

constructor TTestExceptionAddrDirect.Create;
begin
  FInternalExceptionBrkSetMethod := ibmAddrDirect;
  inherited Create;
end;


    //dbg.OnBreakPointHit := @DebuggerBreakPointHit;
    //dbg.OnState         := @DebuggerChangeState;
    //dbg.OnCurrent       := @DebuggerCurrentLine;
    //dbg.OnDbgOutput     := @DebuggerOutput;
    //dbg.OnDbgEvent      := @DebuggerEvent;

procedure TTestExceptionOne.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 TTestExceptionOne.GetLogFileName: String;
begin
  Result := inherited GetLogFileName;
  case FInternalExceptionBrkSetMethod of
    ibmAddrIndirect:  Result := StringReplace(Result, '_', '_AddrIndirect_', []);
    ibmAddrDirect:  Result := StringReplace(Result, '_', '_AddrDirect_', []);
    ibmName:  Result := StringReplace(Result, '_', '_Name_', []);
  end;
end;

procedure TTestExceptionOne.DoCurrent(Sender: TObject; const ALocation: TDBGLocationRec);
begin
  FCurFile := ALocation.SrcFile;
  FCurLine := ALocation.SrcLine;
end;

procedure TTestExceptionOne.TestException;
var
  TestExeName, TstName: string;
  dbg: TGDBMIDebugger;
begin
  if SkipTest then exit;
  if not TestControlCanTest(ControlTestExceptionOneException) then exit;
  ClearTestErrors;
  FContinue := False;

  TstName := 'All';
  TestCompile(AppDir + 'ExceptPrg.pas', TestExeName, '_raise_at', '-gt -dTEST_EXCEPTION_AT');
  FGotExceptCount := 0;
  dbg := StartGDB(AppDir, TestExeName);
  TGDBMIDebuggerPropertiesBase(dbg.GetProperties).InternalExceptionBrkSetMethod := FInternalExceptionBrkSetMethod;
  try
    dbg.OnException      := @DoDebuggerException;

    dbg.Run;
    TstName := 'All - raise';
    LogText('### '+TstName+'   '+TestExeName);
    TestTrue(TstName+'State=Pause', dbg.State = dsPause);
    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',  114, 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';
    LogText('### '+TstName+'   '+TestExeName);
    TestTrue(TstName+'State=Pause', dbg.State = dsPause);
    TestEquals(TstName+' Got exception 2', 2, FGotExceptCount);
    TestEquals(TstName+' Got class', 'Exception', FGotExceptClass);
    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;
    TstName := 'All - raise at 1 down';
    LogText('### '+TstName+'   '+TestExeName);
    TestTrue(TstName+'State=Pause', dbg.State = dsPause);
    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;
    TstName := 'All - raise subclass';
    LogText('### '+TstName+'   '+TestExeName);
    TestTrue(TstName+'State=Pause', dbg.State = dsPause);
    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 -dTEST_SKIP_EXCEPTION_1 -dTEST_RUNERR');
  FGotExceptCount := 0;
  dbg := StartGDB(AppDir, TestExeName);
  try
    dbg.OnException      := @DoDebuggerException;

    dbg.Run;
    LogText('### '+TstName+'   '+TestExeName);
    TestTrue(TstName+'State=Pause', dbg.State = dsPause);
    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 -dTEST_SKIP_EXCEPTION_1 -dTEST_ASSERT');
  FGotExceptCount := 0;
  dbg := StartGDB(AppDir, TestExeName);
  try
    dbg.OnException      := @DoDebuggerException;

    dbg.Run;
    LogText('### '+TstName+'   '+TestExeName);
    TestTrue(TstName+'State=Pause', dbg.State = dsPause);

    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;
    CleanGdb;
    dbg.Free;
  end;

  TestCompile(AppDir + 'ExceptPrg.pas', TestExeName, 'no_etype',
              '-dTEST_NO_EXCEPTION_TYPE -gt ');
  FGotExceptCount := 0; TstName := 'no_exp_type';
  dbg := StartGDB(AppDir, TestExeName);
  try
    dbg.OnException      := @DoDebuggerException;

    dbg.Run;
    LogText('### '+TstName+'   '+TestExeName);
    TestTrue(TstName+'State=Pause', dbg.State = dsPause);
    TestEquals(TstName+' Got 1 exception', 1, FGotExceptCount);
    TestEquals(TstName+' Got class', 'Exception', FGotExceptClass);
    TestEquals(TstName+' Got msg',   'foo', FGotExceptMsg, 050300);
    dbg.Run;
    TestEquals(TstName+' Got no more exception', 1, FGotExceptCount);
    dbg.Stop;
  finally
    dbg.Done;
    CleanGdb;
    dbg.Free;
  end;

  TestCompile(AppDir + 'ExceptPrg.pas', TestExeName, 'no_etype_ptr',
              '-dTEST_NO_EXCEPTION_TYPE -dTEST_NO_POINTER_VAR -gt ');
  FGotExceptCount := 0; TstName := 'no_exp_type_ptr';
  dbg := StartGDB(AppDir, TestExeName);
  try
    dbg.OnException      := @DoDebuggerException;

    dbg.Run;
    LogText('### '+TstName+'   '+TestExeName);
    TestTrue(TstName+'State=Pause', dbg.State = dsPause);
    TestEquals(TstName+' Got 1 exception', 1, FGotExceptCount);
    TestEquals(TstName+' Got class', 'Exception', FGotExceptClass);
    TestEquals(TstName+' Got msg',   'foo', FGotExceptMsg, 050300);
    dbg.Run;
    TestEquals(TstName+' Got no more exception', 1, FGotExceptCount);
    dbg.Stop;
  finally
    dbg.Done;
    CleanGdb;
    dbg.Free;
  end;

  TestCompile(AppDir + 'ExceptPrg.pas', TestExeName, 'no_etype_str',
              '-dTEST_NO_EXCEPTION_TYPE -dTEST_NO_STRING_VAR -gt ');
  FGotExceptCount := 0; TstName := 'no_exp_type_str';
  dbg := StartGDB(AppDir, TestExeName);
  try
    dbg.OnException      := @DoDebuggerException;

    dbg.Run;
    LogText('### '+TstName+'   '+TestExeName);
    TestTrue(TstName+'State=Pause', dbg.State = dsPause);
    TestEquals(TstName+' Got 1 exception', 1, FGotExceptCount);
    TestEquals(TstName+' Got class', 'Exception', FGotExceptClass);
    TestEquals(TstName+' Got msg',   'foo', FGotExceptMsg, 050300);
    dbg.Run;
    TestEquals(TstName+' Got no more exception', 1, FGotExceptCount);
    dbg.Stop;
  finally
    dbg.Done;
    CleanGdb;
    dbg.Free;
  end;

  TestCompile(AppDir + 'ExceptPrg.pas', TestExeName, 'no_etype_ptr_str',
               '-dTEST_NO_EXCEPTION_TYPE -dTEST_NO_POINTER_VAR -gt ');
  FGotExceptCount := 0; TstName := 'no_exp_type_ptr_str';
  dbg := StartGDB(AppDir, TestExeName);
  try
    dbg.OnException      := @DoDebuggerException;

    dbg.Run;
    LogText('### '+TstName+'   '+TestExeName);
    TestTrue(TstName+'State=Pause', dbg.State = dsPause);
    TestEquals(TstName+' Got 1 exception', 1, FGotExceptCount);
    TestEquals(TstName+' Got class', 'Exception', FGotExceptClass);
    TestEquals(TstName+' Got msg',   'foo', FGotExceptMsg, 050300);
    dbg.Run;
    TestEquals(TstName+' Got no more exception', 1, FGotExceptCount);
    dbg.Stop;
  finally
    dbg.Done;
    CleanGdb;
    dbg.Free;
  end;

  TestCompile(AppDir + 'ExceptPrg.pas', TestExeName, 'no_etype_ptr_str_var',
               '-dTEST_NO_EXCEPTION_TYPE -dTEST_NO_POINTER_VAR -dTEST_NO_EXCEPTION_VAR -gt ');
  FGotExceptCount := 0; TstName := 'no_exp_type_ptr_str_var';
  dbg := StartGDB(AppDir, TestExeName);
  try
    dbg.OnException      := @DoDebuggerException;

    dbg.Run;
    LogText('### '+TstName+'   '+TestExeName);
    TestTrue(TstName+'State=Pause', dbg.State = dsPause);
    TestEquals(TstName+' Got 1 exception', 1, FGotExceptCount);
    TestEquals(TstName+' Got class', 'Exception', FGotExceptClass);
    TestEquals(TstName+' Got msg',   'foo', FGotExceptMsg, 050300);
    dbg.Run;
    TestEquals(TstName+' Got no more exception', 1, FGotExceptCount);
    dbg.Stop;
  finally
    dbg.Done;
    CleanGdb;
    dbg.Free;
  end;



  TestCompile(AppDir + 'ExceptPrg.pas', TestExeName, 'with_hplus', '-dTEST_WITH_HPLUS -gt ');
  FGotExceptCount := 0; TstName := 'with_hplus';
  dbg := StartGDB(AppDir, TestExeName);
  try
    dbg.OnException      := @DoDebuggerException;

    dbg.Run;
    LogText('### '+TstName+'   '+TestExeName);
    TestTrue(TstName+'State=Pause', dbg.State = dsPause);
    TestEquals(TstName+' Got 1 exception', 1, FGotExceptCount);
    TestEquals(TstName+' Got class', 'Exception', FGotExceptClass);
    TestEquals(TstName+' Got msg',   'foo', FGotExceptMsg, 050300);
    dbg.Run;
    TestEquals(TstName+' Got 2nd exception', 2, FGotExceptCount);
    TestEquals(TstName+' Got class', 'MyESome', FGotExceptClass);
    //TestEquals(TstName+' Got msg',   'abc üü {[''''[{ \n\t''#13#9''#', FGotExceptMsg, 050300);
    TestEquals(TstName+' Got msg',   'abc üü {[''[{ \n\t'#13#9'#', FGotExceptMsg, 050300);

    dbg.Run;
    TestEquals(TstName+' Got no more exception', 2, FGotExceptCount);

    dbg.Stop;
  finally
    dbg.Done;
    CleanGdb;
    dbg.Free;
  end;



  AssertTestErrors;
end;

procedure TTestExceptionOne.TestExceptionStepOut;
var
  TestExeName, TstName: string;
  dbg: TGDBMIDebugger;
begin
  if SkipTest then exit;
  if not TestControlCanTest(ControlTestExceptionOneExceptionStepOut) then exit;
  ClearTestErrors;
  FContinue := False;

  Src := GetCommonSourceFor(AppDir + 'ExceptPrgStep.pas');
  TestCompile(Src, TestExeName);

  FGotExceptCount := 0; TstName := 'STEP';
  dbg := StartGDB(AppDir, TestExeName);
  try
    dbg.OnException      := @DoDebuggerException;
    dbg.OnCurrent        := @DoCurrent;

    with dbg.BreakPoints.Add('ExceptPrgStep.pas', BREAK_LINE_EXCEPT_END) do begin
      InitialEnabled := True;
      Enabled := True;
    end;

    dbg.Run;
    LogText('### 1 '+TstName+'   '+TestExeName);
    TestTrue(TstName+'State=Pause', dbg.State = dsPause);
    TestEquals(TstName+' Got 1 exception', 1, FGotExceptCount);

    dbg.StepOver;
    TestTrue(TstName+' (Stepped) at break '+IntToStr(FCurLine),
             (FCurLine <= BREAK_LINE_EXCEPT_1) and (FCurLine >= BREAK_LINE_EXCEPT_1 - 2));
    TestEquals(TstName+' (Stepped) Still Got 1 exception', 1, FGotExceptCount);


    dbg.Run;
    LogText('### 2 '+TstName+'   '+TestExeName);
    TestTrue(TstName+'State=Pause', dbg.State = dsPause);
    TestEquals(TstName+' Got 2 exception', 2, FGotExceptCount);

    dbg.StepOver;
    TestTrue(TstName+' (Stepped 2) at break '+IntToStr(FCurLine),
             (FCurLine <= BREAK_LINE_EXCEPT_2) and (FCurLine >= BREAK_LINE_EXCEPT_2 - 2));
    TestEquals(TstName+' (Stepped 2) Still Got 2 exception', 2, FGotExceptCount);


    dbg.Run;
    LogText('### 3 '+TstName+'   '+TestExeName);
    TestTrue(TstName+'State=Pause', dbg.State = dsPause);
    TestEquals(TstName+' Got 3 exception', 3, FGotExceptCount);

    dbg.StepOver;
    TestTrue(TstName+' (Stepped 2) at break '+IntToStr(FCurLine),
             (FCurLine <= BREAK_LINE_EXCEPT_3) and (FCurLine >= BREAK_LINE_EXCEPT_3 - 2));
    TestEquals(TstName+' (Stepped 3) Still Got 3 exception', 3, FGotExceptCount);

    dbg.StepOver;
    TestTrue(TstName+' (Stepped 4) at break '+IntToStr(FCurLine),
             (FCurLine <= BREAK_LINE_EXCEPT_4) and (FCurLine >= BREAK_LINE_EXCEPT_4 - 2));
    TestEquals(TstName+' (Stepped 4) Still Got 3 exception', 3, FGotExceptCount);


    dbg.Run; // run to break (tmp break cleared)
    TestEquals(TstName+' at break', BREAK_LINE_EXCEPT_END, FCurLine);
    TestEquals(TstName+' Still Got 3 exception', 3, FGotExceptCount);

    dbg.Stop;
  finally
    dbg.Done;
    CleanGdb;
    dbg.Free;
  end;

  AssertTestErrors;
end;

procedure TTestExceptionOne.TestExceptionStepOver;
var
  TestExeName, TstName: string;
  dbg: TGDBMIDebugger;
begin
  if SkipTest then exit;
  if not TestControlCanTest(ControlTestExceptionOneExceptionStepOver) then exit;
  ClearTestErrors;
  FContinue := True;

  Src := GetCommonSourceFor(AppDir + 'ExceptPrgStepOver.pas');
  TestCompile(Src, TestExeName, '', '');

  FGotExceptCount := 0; TstName := 'STEPOVER ';
  dbg := StartGDB(AppDir, TestExeName);
  try
    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;


procedure TTestExceptionOne.TestLocation(ATestName, ABrkName: String;
  AnAllowLineBefore: Integer; AnAltBrkName: String);
var
  l, b: Integer;
  ok: Boolean;
  lc: TDBGLocationRec;
begin
  AssertDebuggerState(dsPause, ATestName);
  lc := Debugger.LazDebugger.GetLocation;
  l := lc.SrcLine;
  b := Src.BreakPoints[ABrkName];
  ATestName := ATestName + ' Loc at Line=' + IntToStr(l) + ' ' + lc.SrcFile + ' Expected='+IntToStr(b)+' '+ABrkName;
  ok := (l >= b - AnAllowLineBefore) and (l <= b);
  if (AnAltBrkName = '') or ok then begin
    TestTrue(ATestName+' '+ABrkName+' Loc', ok);
  end
  else begin
    ATestName := ATestName + ' ALTERNATE-Exp='+IntToStr(b)+ ' '+AnAltBrkName;
    b := Src.BreakPoints[AnAltBrkName];
    if b=l then
      TestTrue(ATestName+' '+ABrkName+' Loc', false, 0, ' // Ignored for alternate name');
    TestTrue(ATestName+' '+ABrkName+' Loc', b = l);
  end;
end;

function TTestExceptionOne.IsAtLine(ABrkName: String; ATrueOnNoLine: Boolean
  ): Boolean;
var
  l, b: Integer;
  lc: TDBGLocationRec;
begin
  lc := Debugger.LazDebugger.GetLocation;
  if (lc.SrcFile = '') then
    exit(ATrueOnNoLine);

  l := Debugger.LazDebugger.GetLocation.SrcLine;
  b := Src.BreakPoints[ABrkName];
  Result := b = l;
end;

function TTestExceptionOne.StepOverToLine(ATestName, ABrkName: String;
  AnExitIfNoLineInfo: Boolean): Boolean;
var
  mx: Integer;
begin
  mx := 100; // max steps
  Result := True;
  while not IsAtLine(ABrkName, AnExitIfNoLineInfo) do begin
    Debugger.LazDebugger.StepOver;
    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 TTestExceptionOne.StepOverLeaveFinally(ATestName: String): Boolean;
var
  mx: Integer;
  lc1, lc2: TDBGLocationRec;
begin
  Result := True;
  //somehow gdb does not always a full step, but does asm stepping on the "end" line
  lc1 := Debugger.LazDebugger.GetLocation;
  Debugger.LazDebugger.StepOver;
  AssertDebuggerState(dsPause, ATestName);

  // some lines in the "end" keyword may be without line number (for gdb), and not step correctly
  lc2 := Debugger.LazDebugger.GetLocation;
  if (lc2.SrcLine > 0) or (lc1.FuncName <> lc2.FuncName) then
    exit;

  if lc1.FuncName = lc2.FuncName then TestTrue('BAD FIN STEP ' + ATestName, false, 0, ' ignore');

  mx := 5; // max steps
  while (lc1.FuncName = lc2.FuncName) and (lc2.SrcLine < 1) do begin
    Debugger.LazDebugger.StepOver;
    AssertDebuggerState(dsPause, ATestName);
    dec(mx);
    if mx = 0 then begin
      TestTrue(ATestName+'reached step target FIN', False);
      Result := False;
      break;
    end;
  lc2 := Debugger.LazDebugger.GetLocation;
  end;
  debugln(['XXXXXXXXXXXXXXXXXXXXXXXX to FIN  ',ATestName]);
end;

procedure TTestExceptionOne.TestExceptionStepOutEx;
  function StepIfAtLine(ATestName, ABrkName: String): Boolean;
  begin
    Result := True;
    if not IsAtLine(ABrkName) then
      exit;
    Debugger.LazDebugger.StepOver;
    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;

var
  ExeName, TstName: String;
  dbg: TGDBMIDebugger;
begin
  if SkipTest then exit;
  if not TestControlCanTest(ControlTestExceptionOneExceptionStepOutEx) then exit;
  ClearTestErrors;

  Src := GetCommonSourceFor(AppDir + 'ExceptTestPrg.pas');
  TestCompile(Src, ExeName);

  FGotExceptCount := 0;
  dbg := StartGDB(AppDir, ExeName);
  try
    dbg.Exceptions.Add('MyExceptionIgnore').Enabled := False;
    dbg.OnException      := @DoDebuggerException;
    dbg.OnCurrent        := @DoCurrent;

    TstName := ' Run to Except';
    FContinue := False;
    dbg.Run;
    TestEquals(TstName+': Got 1 exceptions: ', 1, FGotExceptCount);
    TestLocation(TstName+': CurLine ', 'BrkMyRaise');
    FContinue := True;

    dbg.StepOver;
    StepIfAtLine(TstName, 'BrkStep3Fin_A_END');
    TestLocation(TstName+': CurLine ', 'BrkStep3Fin_A', 1);

    dbg.StepOut;
    StepIfAtLine(TstName, 'BrkStep3FinOuter_A_END');
    TestLocation(TstName+': CurLine ', 'BrkStep3FinOuter_A', 1);

    dbg.StepOut;
    TestLocation(TstName+': CurLine ', 'BrkStepMainExcept1', 1 );


    dbg.Stop;
  finally
    dbg.Done;
    CleanGdb;
    dbg.Free;
  end;

  AssertTestErrors;
end;

procedure TTestExceptionOne.TestExceptionStepOverEx;
var
  dbg: TGDBMIDebugger;

  function StepIfAtLine(ATestName, ABrkName: String): Boolean;
  begin
    Result := True;
    if not IsAtLine(ABrkName) then
      exit;
    Debugger.LazDebugger.StepOver;
    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 ExpectEnterFinally(AName: String; ATestAppRecStep: Integer;
    ATestIgnoreRaise, ATestRaiseSkipped: Boolean;
    ATestIgnoreRaise_2, ATestRaiseSkipped_2: Boolean);
  var
    TstName: String;
    MyRaiseBrk: TDBGBreakPoint;
  begin
    TstName := AName + ' Run to raise';
    FGotExceptCount := 0;
    FContinue := ATestIgnoreRaise;

    if ATestIgnoreRaise then begin
      MyRaiseBrk := Debugger.SetBreakPoint(Src, 'BrkMyRaise');
      dbg.Run;
      MyRaiseBrk.ReleaseReference;
      dbg.StepOver;  // exception will be ignored => step to finally
      TestEquals(TstName+': Got 1 exceptions: ', 1, FGotExceptCount);
    end
    else begin
      dbg.Run;
      TestEquals(TstName+': Got 1 exceptions: ', 1, FGotExceptCount);
      TestLocation(TstName+': CurLine ', 'BrkMyRaise');
      dbg.StepOver;
    end;

    TstName := AName + ' Run to Finally A';
    StepIfAtLine(TstName, 'BrkStep3Fin_A_END');
    TestLocation(TstName+': CurLine ', 'BrkStep3Fin_A', 1);

    if (ATestAppRecStep = 1) and (not ATestRaiseSkipped) then
      ExpectEnterFinally(TstName+' INNER ', 0, ATestIgnoreRaise_2, ATestRaiseSkipped_2, False, False)
    else
      StepOverToLine(TstName, 'BrkStep3Fin_A_END', True);

    TstName := AName + ' Run to Finally B';
    StepOverLeaveFinally(TstName);  // Step to next finally
    StepIfAtLine(TstName, 'BrkStep3Fin_B_END');
    TestLocation(TstName+': CurLine ', 'BrkStep3Fin_B', 1);

    //if (ATestAppRecStep = 2) and (not ATestRaiseSkipped) then
    //  ExpectEnterFinally(TstName+' INNER ', 0, ATestIgnoreRaise_2, ATestRaiseSkipped_2, False, False)
    //else
      StepOverToLine(TstName, 'BrkStep3Fin_B_END', True);

    TstName := AName + ' Run to Finally C';
    StepOverLeaveFinally(TstName);  // Step to next finally
    StepIfAtLine(TstName, 'BrkStep3Fin_C_END');
    TestLocation(TstName+': CurLine ', 'BrkStep3Fin_C', 1);

    if (ATestAppRecStep = 2) and (not ATestRaiseSkipped) then
      ExpectEnterFinally(TstName+' INNER ', 0, ATestIgnoreRaise_2, ATestRaiseSkipped_2, False, False)
    else
      StepOverToLine(TstName, 'BrkStep3Fin_C_END', True);

    TstName := AName + ' Run to Finally A(outer)';
    StepOverLeaveFinally(TstName);  // Step to next finally
    StepIfAtLine(TstName, 'BrkStep3FinOuter_A_END');
    TestLocation(TstName+': CurLine ', 'BrkStep3FinOuter_A', 1);

    if (ATestAppRecStep = 3) and (not ATestRaiseSkipped) then
      ExpectEnterFinally(TstName+' INNER ', 0, ATestIgnoreRaise_2, ATestRaiseSkipped_2, False, False)
    else
      StepOverToLine(TstName, 'BrkStep3FinOuter_A_END', True);

    TstName := AName + ' Run to Finally B(outer)';
    StepOverLeaveFinally(TstName);  // Step to next finally
    StepIfAtLine(TstName, 'BrkStep3FinOuter_B_END');
    TestLocation(TstName+': CurLine ', 'BrkStep3FinOuter_B', 1);

    //if (ATestAppRecStep = 5) and (not ATestRaiseSkipped) then
    //  ExpectEnterFinally(TstName+' INNER ', 0, ATestIgnoreRaise_2, ATestRaiseSkipped_2, False, False)
    //else
      StepOverToLine(TstName, 'BrkStep3FinOuter_B_END', True);

    TstName := AName + ' Run to Finally C(outer)';
    StepOverLeaveFinally(TstName);  // Step to next finally
    StepIfAtLine(TstName, 'BrkStep3FinOuter_C_END');
    TestLocation(TstName+': CurLine ', 'BrkStep3FinOuter_C', 1);

    if (ATestAppRecStep = 4) and (not ATestRaiseSkipped) then
      ExpectEnterFinally(TstName+' INNER ', 0, ATestIgnoreRaise_2, ATestRaiseSkipped_2, 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;
    dbg.Run;
    TestEquals(TstName+': Got 1 exceptions: ', 1, FGotExceptCount);
    TestLocation(TstName+': CurLine ', 'BrkMyRaise');

    TstName := AName + ' Run to except fin';
    dbg.StepOver;  // Step to fin
    StepIfAtLine(TstName, 'BrkStepNestedExcept_Finally_END');
    TestLocation(TstName+': CurLine ', 'BrkStepNestedExcept_Finally', 1);

    // NESTED
    TstName := AName + ' Run to raise nested';
    FGotExceptCount := 0;
    FContinue := False;
    dbg.Run;
    TestEquals(TstName+': Got 1 exceptions: ', 1, FGotExceptCount);
    TestLocation(TstName+': CurLine ', 'BrkMyRaise');

    TstName := AName + ' Run to except fin nested';
    dbg.StepOver;  // Step to fin
    StepIfAtLine(TstName, 'BrkStepNestedExcept_Finally_END');
    TestLocation(TstName+': CurLine ', 'BrkStepNestedExcept_Finally', 1);

    StepOverToLine(TstName,'BrkStepNestedExcept_Finally_END', True);

    TstName := AName + ' Run to except nested';
    StepOverLeaveFinally(TstName);
    StepIfAtLine(TstName, 'BrkStepNestedExcept_END');
    TestLocation(TstName+': CurLine ', 'BrkStepNestedExcept', 1);

    StepOverToLine(TstName,'BrkStepNestedExcept_END', True);
    // END NESTED

    TstName := AName + ' Run back except fin';
    dbg.StepOver;  // Step back to end
    dbg.StepOver;  // Step back to finaly
    if not IsAtLine('BrkStepNestedExcept_Finally_AFTER') then dbg.StepOver;  // sometimes need extra steps at "end"
    if not IsAtLine('BrkStepNestedExcept_Finally_AFTER') then dbg.StepOver;  // sometimes need extra steps at "end"
    TestLocation(TstName+': CurLine ', 'BrkStepNestedExcept_Finally_AFTER', 1);

    StepOverToLine(TstName,'BrkStepNestedExcept_Finally_END', True);

    TstName := AName + ' Run to except';
    StepOverLeaveFinally(TstName);
    StepIfAtLine(TstName, 'BrkStepNestedExcept_END');
    TestLocation(TstName+': CurLine ', 'BrkStepNestedExcept', 1);

    //StepOverToLine(TstName,'BrkStepNestedExcept_END', True);
    dbg.StepOut;  // Step out
  end;

  procedure ExpectNestedExcept_Ignore(AName: String);
  var
    TstName: String;
  begin
    TstName := AName + ' Run to raise';
    FGotExceptCount := 0;
    FContinue := False;
    dbg.Run;
    TestEquals(TstName+': Got 1 exceptions: ', 1, FGotExceptCount);
    TestLocation(TstName+': CurLine ', 'BrkMyRaise');

    TstName := AName + ' Run to except fin';
    dbg.StepOver;  // Step to fin
    StepIfAtLine(TstName, 'BrkStepNestedExcept_Finally_END');
    TestLocation(TstName+': CurLine ', 'BrkStepNestedExcept_Finally', 1);

    // NESTED
    TstName := AName + ' Step over raise nested';
    FGotExceptCount := 0;
    FContinue := True;
    StepOverToLine(TstName,'BrkStepNestedExcept_Finally_BEFORE', True);
    dbg.StepOver;
    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';
    StepOverLeaveFinally(TstName);
    StepIfAtLine(TstName, 'BrkStepNestedExcept_END');
    TestLocation(TstName+': CurLine ', 'BrkStepNestedExcept', 1);

    //StepOverToLine(TstName,'BrkStepNestedExcept_END', True);
    dbg.StepOut;  // Step out

  end;

var
  ExeName, TstName, LName: String;
  TestAppRecRaise, TestAppRecStep: Integer;
begin
  if SkipTest then exit;
  if not TestControlCanTest(ControlTestExceptionOneExceptionStepOverEx) then exit;
  ClearTestErrors;

  Src := GetCommonSourceFor(AppDir + 'ExceptTestPrg.pas');
  TestCompile(Src, ExeName);

  dbg := StartGDB(AppDir, ExeName);
  try
    dbg.Exceptions.Add('MyExceptionIgnore').Enabled := False;
    dbg.OnException      := @DoDebuggerException;
    dbg.OnCurrent        := @DoCurrent;

    for TestAppRecRaise := 0 to 2 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,
         TestAppRecRaise = 1, TestAppRecRaise = 2);

      TstName := LName + ' Run to Except (Main)';
      StepOverLeaveFinally(TstName);
      TestLocation(TstName+': CurLine ', 'BrkStepMainExcept1', 1);

      TstName := LName + ' Step to After Except (Main)';
      dbg.StepOver;
      StepOverToLine(TstName,'BrkStepMainAfterExcept1', True);
      TestLocation(TstName+': CurLine ', 'BrkStepMainAfterExcept1', 1);
    end;

    ExpectNestedExcept('Nested Except 1');

    ExpectNestedExcept_Ignore('Nested Except Ignore');

    dbg.Stop;
  finally
    dbg.Done;
    CleanGdb;
    dbg.Free;
  end;

  AssertTestErrors;
end;

initialization
  RegisterDbgTest(TTestExceptionAddrDirect);
  RegisterDbgTest(TTestExceptionAddrInDirect, [stDwarfSet, stStabs]);
  RegisterDbgTest(TTestExceptionForceName, [stDwarfSet, stStabs]);

  ControlTestExceptionOne                  := TestControlRegisterTest('TTestExceptionOne');
  ControlTestExceptionOneException         := TestControlRegisterTest('Exception', ControlTestExceptionOne);
  ControlTestExceptionOneExceptionStepOut  := TestControlRegisterTest('ExceptionStepOut', ControlTestExceptionOne);
  ControlTestExceptionOneExceptionStepOver := TestControlRegisterTest('ExceptionStepOver', ControlTestExceptionOne);
  ControlTestExceptionOneExceptionStepOutEx  := TestControlRegisterTest('ExceptionStepOutEx', ControlTestExceptionOne);
  ControlTestExceptionOneExceptionStepOverEx := TestControlRegisterTest('ExceptionStepOverEx', ControlTestExceptionOne);
end.