Commit | Line | Data |
9132e1a3 |
1 | ################################################################################ |
2 | ## |
3 | ## $Revision: 2 $ |
4 | ## $Author: mhx $ |
5 | ## $Date: 2005/01/31 08:10:51 +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 dJMPENV |
29 | |
30 | # ifndef dXCPT |
31 | # define dXCPT dJMPENV; int rEtV = 0 |
32 | # define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0) |
33 | # define XCPT_TRY_END JMPENV_POP; |
34 | # define XCPT_CATCH if (rEtV != 0) |
35 | # define XCPT_RETHROW JMPENV_JUMP(rEtV) |
36 | # endif |
37 | |
38 | #else |
39 | |
40 | # define dXCPT Sigjmp_buf oldTOP; int rEtV = 0 |
41 | # define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0) |
42 | # define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf); |
43 | # define XCPT_CATCH if (rEtV != 0) |
44 | # define XCPT_RETHROW Siglongjmp(top_env, rEtV) |
45 | |
46 | #endif |
47 | |
48 | =xsmisc |
49 | |
50 | static void throws_exception(int throw_e) |
51 | { |
52 | if (throw_e) |
53 | croak("boo\n"); |
54 | } |
55 | |
56 | static int exception(int throw_e) |
57 | { |
58 | dTHR; |
59 | dXCPT; |
60 | SV *caught = get_sv("Devel::PPPort::exception_caught", 0); |
61 | |
62 | XCPT_TRY_START { |
63 | throws_exception(throw_e); |
64 | } XCPT_TRY_END |
65 | |
66 | XCPT_CATCH |
67 | { |
68 | sv_setiv(caught, 1); |
69 | XCPT_RETHROW; |
70 | } |
71 | |
72 | sv_setiv(caught, 0); |
73 | |
74 | return 42; |
75 | } |
76 | |
77 | =xsubs |
78 | |
79 | int |
80 | exception(throw_e) |
81 | int throw_e |
82 | OUTPUT: |
83 | RETVAL |
84 | |
85 | =tests plan => 7 |
86 | |
87 | my $rv; |
88 | |
89 | $Devel::PPPort::exception_caught = undef; |
90 | |
91 | $rv = eval { &Devel::PPPort::exception(0) }; |
92 | ok($@, ''); |
93 | ok(defined $rv); |
94 | ok($rv, 42); |
95 | ok($Devel::PPPort::exception_caught, 0); |
96 | |
97 | $Devel::PPPort::exception_caught = undef; |
98 | |
99 | $rv = eval { &Devel::PPPort::exception(1) }; |
100 | ok($@, "boo\n"); |
101 | ok(not defined $rv); |
102 | ok($Devel::PPPort::exception_caught, 1); |