This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to Devel::PPPort 3.07
[perl5.git] / ext / Devel / PPPort / module3.c
1 /*******************************************************************************
2 *
3 *  Perl/Pollution/Portability
4 *
5 ********************************************************************************
6 *
7 *  $Revision: 8 $
8 *  $Author: mhx $
9 *  $Date: 2006/01/14 18:07:56 +0100 $
10 *
11 ********************************************************************************
12 *
13 *  Version 3.x, Copyright (C) 2004-2006, Marcus Holland-Moritz.
14 *  Version 2.x, Copyright (C) 2001, Paul Marquess.
15 *  Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
16 *
17 *  This program is free software; you can redistribute it and/or
18 *  modify it under the same terms as Perl itself.
19 *
20 *******************************************************************************/
21
22 #include "EXTERN.h"
23 #include "perl.h"
24
25 #define NO_XSLOCKS
26 #include "XSUB.h"
27
28 #include "ppport.h"
29
30 static void throws_exception(int throw_e)
31 {
32   if (throw_e)
33     croak("boo\n");
34 }
35
36 int exception(int throw_e)
37 {
38   dTHR;
39   dXCPT;
40   SV *caught = get_sv("Devel::PPPort::exception_caught", 0);
41
42   XCPT_TRY_START {
43     throws_exception(throw_e);
44   } XCPT_TRY_END
45
46   XCPT_CATCH
47   {
48     sv_setiv(caught, 1);
49     XCPT_RETHROW;
50   }
51
52   sv_setiv(caught, 0);
53
54   return 42;
55 }
56
57 void call_newCONSTSUB_3(void)
58 {
59   newCONSTSUB(gv_stashpv("Devel::PPPort", FALSE), "test_value_3", newSViv(3));
60 }
61
62 U32 get_PL_signals_3(void)
63 {
64   return PL_signals;
65 }