Delphi XE2+ 测试Pthread异常

program Test_exception1;

{$IFDEF FPC}
  {$MODE Delphi}//MacPas}
  {$assertions on}
{$ENDIF}

{$APPTYPE CONSOLE}

{$R *.res}
{$DEFINE __PTW32_MUTEX_TYPES}
uses
  {$IFnDEF FPC}
  System.SysUtils,
  System.Win.Crtl,
  Winapi.Windows,
  {$ELSE}
  Sysutils,
  {$ENDIF}
  libc.Types in 'libc.Types.pas',
  pthreads.win in 'pthreads.win.pas',
  pthreads.sem in 'pthreads.sem.pas',
  pthreads.sched in 'pthreads.sched.pas',
  pthreads.barrier in 'pthreads.barrier.pas',
  pthreads.mutex in 'pthreads.mutex.pas',
  pthreads.mutexattr in 'pthreads.mutexattr.pas',
  pthreads.spin in 'pthreads.spin.pas',
  pthreads.attr in 'pthreads.attr.pas',
  pthreads.cond in 'pthreads.cond.pas',
  pthreads.condattr in 'pthreads.condattr.pas',
  pthreads.rwlock in 'pthreads.rwlock.pas',
  pthreads.ptw32 in 'pthreads.ptw32.pas',
  pthreads.oldmutex in 'pthreads.oldmutex.pas',
  pthreads.core in 'pthreads.core.pas',
  pthreads.CPU in 'pthreads.CPU.pas',
  QueueUser_APCEx in 'QueueUser_APCEx.pas';

const
  NUMTHREADS = 4;

procedure DoMessage(&Message, Filename: String; LineNumber: Integer; ErrorAddr: Pointer);
var
  S: String;
begin
  S := Format('%s (%s, line %d, address $%p)',
    [&Message, Filename, LineNumber, ErrorAddr]);// Pred(Integer(ErrorAddr))]);
  //OutputDebugString(PChar(S));
  Writeln(S);
end;

procedure DoSucceedMessage(&Message, Filename: String; LineNumber: Integer; ErrorAddr: Pointer);
var
  S: String;
begin
  S := Format('%s (%s, line %d, address $%x)',
    ['Assertion succeeded:', Filename, LineNumber, Pred(Integer(ErrorAddr))]);
  //OutputDebugString(PChar(S));
  Writeln(S);
end;

procedure AssertErrorHandler(const &Message, Filename: string;  LineNumber: Integer; ErrorAddr: Pointer);
{ No local variables. Not compiler generated temporary variables. }
{ Using the call stack here will cause Access Violation errors. }
begin
  DoMessage(&Message, Filename, LineNumber, ErrorAddr);
  //raise EMyAssert.Create('Boom!');
end;

procedure AssertErrorNoHandler(const &Message, Filename: string; LineNumber: Integer; ErrorAddr: Pointer);
begin
  DoSucceedMessage(&Message, Filename, LineNumber, ErrorAddr);
end;

function exceptionedThread( arg : Pointer):Pointer;
var
  dummy : integer;
  zero, one : integer;
begin
  dummy := 0;
  result := Pointer(int(PTHREAD_CANCELED) + 1);
  { Set to async cancelable }
  assert(pthread_setcancelstate(PTHREAD_CANCEL_ENABLE, nil) = 0);
  assert(pthread_setcanceltype(PTHREAD_CANCEL_ASYNCHRONOUS, nil) = 0);
  Sleep(100);
{$IF  not defined(__cplusplus)}
  try

    zero := int( size_t(arg));
    one := 1;
    {
     * The deliberate exception condition (zero divide) is
     * in an 'if' to avoid being optimised out.
     }
    if dummy = one div zero then
       Sleep(0);

  except On E: Exception do

    { Should get into here. }
    result := Pointer(Int(size_t(PTHREAD_CANCELED)) + 2);
  end;
{$elseif defined(__cplusplus)}
  try
  begin
    {
     * I had a zero divide exception here but it
     * wasn't being caught by the catch(...)
     * below under Mingw32. That could be a problem.
     }
    {
     [i_a]
     Addendum: PostInc(C) try/catch generally do not catch
     access violations of that sort, as division by
     zero is considered a 'floating point exception',
     even when the division is an integer one.
     So it may be caught by a custom SIGFPE handler instead.
  }
  end;
{$IF defined(__PtW32CatchAll)}
  __PtW32CatchAll
{$ELSE}
  catch (...)
{$ENDIF}
  begin
    { Should get into here. }
    result := (Pointer)((int)(size_t)PTHREAD_CANCELED + 2);
  end;
{$ENDIF}
  Result := Pointer (size_t(result));
end;

function canceledThread( arg : Pointer):Pointer;
var
  count : integer;
begin
  result := Pointer(int(size_t(PTHREAD_CANCELED)) + 1);
  { Set to async cancelable }
  assert(pthread_setcancelstate(PTHREAD_CANCEL_ENABLE, nil) = 0);
  assert(pthread_setcanceltype(PTHREAD_CANCEL_ASYNCHRONOUS, nil) = 0);
{$IF not defined(__cplusplus)}
  try

    {
     * We wait up to 10 seconds, waking every 0.1 seconds,
     * for a cancellation to be applied to us.
     }
    for count := 0 to 99 do
      Sleep(100);

  except on E: Exception do

    { Should NOT get into here. }
    result := Pointer(int(size_t(PTHREAD_CANCELED)) + 2);
  end;
{$ELSEif defined(__cplusplus) }
  try
  begin
    {
     * We wait up to 10 seconds, waking every 0.1 seconds,
     * for a cancellation to be applied to us.
     }
    for count := 0 to 99 do
      Sleep(100);
  end;
{$IF defined(__PtW32CatchAll)}
  __PtW32CatchAll
{$ELSE}
  catch (...)
{$ENDIF}
  begin
    { Should NOT get into here. }
    result := (Pointer)((int)(size_t)PTHREAD_CANCELED + 2);
  end;
{$ENDIF}
  Result := Pointer(size_t(result));
end;


function main:integer;
var
  _failed: bool;
  i : integer;
  mt : pthread_t;
  et, ct : array[0..(NUMTHREADS)-1] of pthread_t;
  dwMode : DWORD;
  result1: Pointer;
  fail : bool;
begin
  _failed := Boolean(0);
  dwMode := SetErrorMode(SEM_NOGPFAULTERRORBOX);
  SetErrorMode(dwMode or SEM_NOGPFAULTERRORBOX);
  mt := pthread_self();
  assert(mt.p <> nil);
  Writeln('create two threads...');
  for i := 0 to NUMTHREADS-1 do
  begin
      Writeln(Format('Create exceptionedThread ID: %d', [I]));
      assert(pthread_create(@et[i], nil, exceptionedThread, Pointer( 0)) = 0);
      Writeln(Format('Create canceledThread ID: %d', [I]));
      assert(pthread_create(@ct[i], nil, canceledThread, nil) = 0);
  end;
  Writeln('end create two threads...'#13#10);
  {
   * Code to control or manipulate child threads should probably go here.
   }
  Sleep(100);
  Writeln('cancel thread arrays: ct...');
  for i := 0 to NUMTHREADS-1 do
  begin
    Writeln(Format('ct id: %d', [I]));
    assert(pthread_cancel(ct[i]) = 0);
  end;
  Writeln('end cancel thread arrays: ct'#13#10);
  {
   * Give threads time to run.
   }
  Sleep(NUMTHREADS * 100);
  {
   * Check any results here. Set 'failed' and only print output on failure.
   }
  Writeln(#10'begin join threads------------------------------------------------');
  _failed := Boolean(0);
  for i := 0 to NUMTHREADS-1 do
    begin
      fail := Boolean(0);
      result1 := Pointer(0);
  { Canceled thread }
      Writeln(Format('join thread ct id: %d', [I]));
      assert(pthread_join(ct[i], &result1) = 0);
      fail := (result1 <> PTHREAD_CANCELED);
      assert( not (fail));
      _failed := (_failed  or  fail);
      { Exceptioned thread }
      Writeln(Format('join thread et id: %d', [I]));
      assert(pthread_join(et[i], &result1) = 0);
      fail := (result1 <> Pointer(int(size_t(PTHREAD_CANCELED)) + 2));
      assert( not (fail));
      _failed := (_failed  or  fail);
    end;
  Writeln('end join threads-----------------------------------------------------'#13#10);
  assert( not _failed);
  {
   * Success.
   }
  Exit(0);
end;

begin
  AssertErrorProc := AssertErrorHandler;
  try
    //System.AssertErrorProc := @AssertErrorNoHandler;
    main;
  except on E: Exception do
    Writeln(E.ClassName, ': ', E.Message);

  end;
end.