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
CommitLineData
9132e1a3
MHM
1################################################################################
2##
2dd69576 3## $Revision: 3 $
9132e1a3 4## $Author: mhx $
2dd69576 5## $Date: 2005/02/02 21:48:36 +0100 $
9132e1a3
MHM
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
20dXCPT
21XCPT_TRY_START
22XCPT_TRY_END
23XCPT_CATCH
24XCPT_RETHROW
25
26=implementation
27
2dd69576
MHM
28#ifdef NO_XSLOCKS
29# ifdef dJMPENV
9132e1a3
MHM
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
MHM
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
MHM
42#endif
43
44=xsmisc
45
2dd69576
MHM
46/* defined in module3.c */
47int exception(int throw_e);
9132e1a3
MHM
48
49=xsubs
50
51int
52exception(throw_e)
53 int throw_e
54 OUTPUT:
55 RETVAL
56
57=tests plan => 7
58
59my $rv;
60
61$Devel::PPPort::exception_caught = undef;
62
63$rv = eval { &Devel::PPPort::exception(0) };
64ok($@, '');
65ok(defined $rv);
66ok($rv, 42);
67ok($Devel::PPPort::exception_caught, 0);
68
69$Devel::PPPort::exception_caught = undef;
70
71$rv = eval { &Devel::PPPort::exception(1) };
72ok($@, "boo\n");
73ok(not defined $rv);
74ok($Devel::PPPort::exception_caught, 1);