This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to Devel::PPPort 3.06.
[perl5.git] / ext / Devel / PPPort / parts / inc / exception
1 ################################################################################
2 ##
3 ##  $Revision: 3 $
4 ##  $Author: mhx $
5 ##  $Date: 2005/02/02 21:48:36 +0100 $
6 ##
7 ################################################################################
8 ##
9 ##  Version 3.x, Copyright (C) 2004-2005, 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);