Commit | Line | Data |
---|---|---|
9132e1a3 MHM |
1 | ################################################################################ |
2 | ## | |
b2049988 | 3 | ## Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz. |
9132e1a3 MHM |
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 | ||
2dd69576 MHM |
22 | #ifdef NO_XSLOCKS |
23 | # ifdef dJMPENV | |
9132e1a3 MHM |
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) | |
2dd69576 MHM |
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) | |
9132e1a3 | 35 | # endif |
9132e1a3 MHM |
36 | #endif |
37 | ||
38 | =xsmisc | |
39 | ||
2dd69576 MHM |
40 | /* defined in module3.c */ |
41 | int exception(int throw_e); | |
9132e1a3 MHM |
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); |