ext/Devel-PPPort/parts/inc/exception

   1 ################################################################################
   2 ##
   3 ##  $Revision: 7 $
   4 ##  $Author: mhx $
   5 ##  $Date: 2009/01/18 14:10:53 +0100 $
   6 ##
   7 ################################################################################
   8 ##
   9 ##  Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz.
  10 ##  Version 2.x, Copyright (C) 2001, Paul Marquess.
  11 ##  Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
  12 ##
  13 ##  This program is free software; you can redistribute it and/or
  14 ##  modify it under the same terms as Perl itself.
  15 ##
  16 ################################################################################
  17
  18 =provides
  19
  20 dXCPT
  21 XCPT_TRY_START
  22 XCPT_TRY_END
  23 XCPT_CATCH
  24 XCPT_RETHROW
  25
  26 =implementation
  27
  28 #ifdef NO_XSLOCKS
  29 #  ifdef dJMPENV
  30 #    define dXCPT             dJMPENV; int rEtV = 0
  31 #    define XCPT_TRY_START    JMPENV_PUSH(rEtV); if (rEtV == 0)
  32 #    define XCPT_TRY_END      JMPENV_POP;
  33 #    define XCPT_CATCH        if (rEtV != 0)
  34 #    define XCPT_RETHROW      JMPENV_JUMP(rEtV)
  35 #  else
  36 #    define dXCPT             Sigjmp_buf oldTOP; int rEtV = 0
  37 #    define XCPT_TRY_START    Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
  38 #    define XCPT_TRY_END      Copy(oldTOP, top_env, 1, Sigjmp_buf);
  39 #    define XCPT_CATCH        if (rEtV != 0)
  40 #    define XCPT_RETHROW      Siglongjmp(top_env, rEtV)
  41 #  endif
  42 #endif
  43
  44 =xsmisc
  45
  46 /* defined in module3.c */
  47 int exception(int throw_e);
  48
  49 =xsubs
  50
  51 int
  52 exception(throw_e)
  53   int throw_e
  54   OUTPUT:
  55     RETVAL
  56
  57 =tests plan => 7
  58
  59 my $rv;
  60
  61 $Devel::PPPort::exception_caught = undef;
  62
  63 $rv = eval { &Devel::PPPort::exception(0) };
  64 ok($@, '');
  65 ok(defined $rv);
  66 ok($rv, 42);
  67 ok($Devel::PPPort::exception_caught, 0);
  68
  69 $Devel::PPPort::exception_caught = undef;
  70
  71 $rv = eval { &Devel::PPPort::exception(1) };
  72 ok($@, "boo\n");
  73 ok(not defined $rv);
  74 ok($Devel::PPPort::exception_caught, 1);