cpan/Devel-PPPort/parts/inc/exception

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