################################################################################
##
##  $Revision: 2 $
##  $Author: mhx $
##  $Date: 2005/01/31 08:10:51 +0100 $
##
################################################################################
##
##  Version 3.x, Copyright (C) 2004-2005, Marcus Holland-Moritz.
##  Version 2.x, Copyright (C) 2001, Paul Marquess.
##  Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
##
##  This program is free software; you can redistribute it and/or
##  modify it under the same terms as Perl itself.
##
################################################################################

=provides

dXCPT
XCPT_TRY_START
XCPT_TRY_END
XCPT_CATCH
XCPT_RETHROW

=implementation

#ifdef dJMPENV

#  ifndef dXCPT
#    define dXCPT             dJMPENV; int rEtV = 0
#    define XCPT_TRY_START    JMPENV_PUSH(rEtV); if (rEtV == 0)
#    define XCPT_TRY_END      JMPENV_POP;
#    define XCPT_CATCH        if (rEtV != 0)
#    define XCPT_RETHROW      JMPENV_JUMP(rEtV)
#  endif

#else

#  define dXCPT             Sigjmp_buf oldTOP; int rEtV = 0
#  define XCPT_TRY_START    Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
#  define XCPT_TRY_END      Copy(oldTOP, top_env, 1, Sigjmp_buf);
#  define XCPT_CATCH        if (rEtV != 0)
#  define XCPT_RETHROW      Siglongjmp(top_env, rEtV)

#endif

=xsmisc

static void throws_exception(int throw_e)
{
  if (throw_e)
    croak("boo\n");
}

static int exception(int throw_e)
{
  dTHR;
  dXCPT;
  SV *caught = get_sv("Devel::PPPort::exception_caught", 0);

  XCPT_TRY_START {
    throws_exception(throw_e);
  } XCPT_TRY_END

  XCPT_CATCH
  {
    sv_setiv(caught, 1);
    XCPT_RETHROW;
  }

  sv_setiv(caught, 0);

  return 42;
}

=xsubs

int
exception(throw_e)
  int throw_e
  OUTPUT:
    RETVAL

=tests plan => 7

my $rv;

$Devel::PPPort::exception_caught = undef;

$rv = eval { &Devel::PPPort::exception(0) };
ok($@, '');
ok(defined $rv);
ok($rv, 42);
ok($Devel::PPPort::exception_caught, 0);

$Devel::PPPort::exception_caught = undef;

$rv = eval { &Devel::PPPort::exception(1) };
ok($@, "boo\n");
ok(not defined $rv);
ok($Devel::PPPort::exception_caught, 1);
