Commit | Line | Data |
9132e1a3 |
1 | ################################################################################ |
2 | ## |
bfc37ff7 |
3 | ## $Revision: 8 $ |
9132e1a3 |
4 | ## $Author: mhx $ |
bfc37ff7 |
5 | ## $Date: 2010/03/07 13:15:46 +0100 $ |
9132e1a3 |
6 | ## |
7 | ################################################################################ |
8 | ## |
bfc37ff7 |
9 | ## Version 3.x, Copyright (C) 2004-2010, Marcus Holland-Moritz. |
9132e1a3 |
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 | |
2dd69576 |
28 | #ifdef NO_XSLOCKS |
29 | # ifdef dJMPENV |
9132e1a3 |
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) |
2dd69576 |
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) |
9132e1a3 |
41 | # endif |
9132e1a3 |
42 | #endif |
43 | |
44 | =xsmisc |
45 | |
2dd69576 |
46 | /* defined in module3.c */ |
47 | int exception(int throw_e); |
9132e1a3 |
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); |