This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add/fix character classification macros, like isDIGIT
[perl5.git] / dist / Devel-PPPort / parts / inc / exception
CommitLineData
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
14dXCPT
15XCPT_TRY_START
16XCPT_TRY_END
17XCPT_CATCH
18XCPT_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 */
41int exception(int throw_e);
9132e1a3
MHM
42
43=xsubs
44
45int
46exception(throw_e)
47 int throw_e
48 OUTPUT:
49 RETVAL
50
51=tests plan => 7
52
53my $rv;
54
55$Devel::PPPort::exception_caught = undef;
56
57$rv = eval { &Devel::PPPort::exception(0) };
58ok($@, '');
59ok(defined $rv);
60ok($rv, 42);
61ok($Devel::PPPort::exception_caught, 0);
62
63$Devel::PPPort::exception_caught = undef;
64
65$rv = eval { &Devel::PPPort::exception(1) };
66ok($@, "boo\n");
67ok(not defined $rv);
68ok($Devel::PPPort::exception_caught, 1);