ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Guard/Guard.xs
(Generate patch)

Comparing Guard/Guard.xs (file contents):
Revision 1.3 by root, Sat Dec 13 19:14:58 2008 UTC vs.
Revision 1.12 by root, Thu Nov 20 18:13:58 2014 UTC

1#define PERL_NO_GET_CONTEXT 1#define PERL_NO_GET_CONTEXT
2 2
3#include "EXTERN.h" 3#include "EXTERN.h"
4#include "perl.h" 4#include "perl.h"
5#include "XSUB.h" 5#include "XSUB.h"
6
7#include "patchlevel.h"
8
9#define PERL_VERSION_ATLEAST(a,b,c) \
10 (PERL_REVISION > (a) \
11 || (PERL_REVISION == (a) \
12 && (PERL_VERSION > (b) \
13 || (PERL_VERSION == (b) && PERL_SUBVERSION >= (c)))))
14
15/* apparently < 5.8.8 */
16#ifndef SvSTASH_set
17# define SvSTASH_set(x,a) SvSTASH(x) = (a)
18#endif
19
20#ifndef PERL_MAGIC_ext
21# define PERL_MAGIC_ext '~'
22#endif
6 23
7static HV *guard_stash; 24static HV *guard_stash;
8 25
9static SV * 26static SV *
10guard_get_cv (pTHX_ SV *cb_sv) 27guard_get_cv (pTHX_ SV *cb_sv)
… …
22static void 39static void
23exec_guard_cb (pTHX_ SV *cb) 40exec_guard_cb (pTHX_ SV *cb)
24{ 41{
25 dSP; 42 dSP;
26 SV *saveerr = SvOK (ERRSV) ? sv_mortalcopy (ERRSV) : 0; 43 SV *saveerr = SvOK (ERRSV) ? sv_mortalcopy (ERRSV) : 0;
44 SV *savedie = PL_diehook;
45
46 PL_diehook = 0;
27 47
28 PUSHSTACKi (PERLSI_DESTROY); 48 PUSHSTACKi (PERLSI_DESTROY);
29 49
30 PUSHMARK (SP); 50 PUSHMARK (SP);
31 PUTBACK; 51 PUTBACK;
32 call_sv (cb, G_VOID | G_DISCARD | G_EVAL); 52 call_sv (cb, G_VOID | G_DISCARD | G_EVAL);
33 SPAGAIN;
34 53
35 if (SvTRUE (ERRSV)) 54 if (SvTRUE (ERRSV))
36 { 55 {
56 SPAGAIN;
57
37 PUSHMARK (SP); 58 PUSHMARK (SP);
38 PUTBACK; 59 PUTBACK;
39 call_sv (get_sv ("Guard::DIED", 1), G_VOID | G_DISCARD | G_EVAL | G_KEEPERR); 60 call_sv (get_sv ("Guard::DIED", 1), G_VOID | G_DISCARD | G_EVAL | G_KEEPERR);
40 SPAGAIN;
41 61
42 sv_setsv (ERRSV, &PL_sv_undef); 62 sv_setpvn (ERRSV, "", 0);
43 } 63 }
44 64
45 if (saveerr) 65 if (saveerr)
46 sv_setsv (ERRSV, saveerr); 66 sv_setsv (ERRSV, saveerr);
67
68 {
69 SV *oldhook = PL_diehook;
70 PL_diehook = savedie;
71 SvREFCNT_dec (oldhook);
72 }
47 73
48 POPSTACK; 74 POPSTACK;
49} 75}
50 76
51static void 77static void
… …
56 82
57static int 83static int
58guard_free (pTHX_ SV *cv, MAGIC *mg) 84guard_free (pTHX_ SV *cv, MAGIC *mg)
59{ 85{
60 exec_guard_cb (aTHX_ mg->mg_obj); 86 exec_guard_cb (aTHX_ mg->mg_obj);
87
88 return 0;
61} 89}
62 90
63static MGVTBL guard_vtbl = { 91static MGVTBL guard_vtbl = {
64 0, 0, 0, 0, 92 0, 0, 0, 0,
65 guard_free 93 guard_free
… …
67 95
68MODULE = Guard PACKAGE = Guard 96MODULE = Guard PACKAGE = Guard
69 97
70BOOT: 98BOOT:
71 guard_stash = gv_stashpv ("Guard", 1); 99 guard_stash = gv_stashpv ("Guard", 1);
72 100 CvNODEBUG_on (get_cv ("Guard::scope_guard", 0)); /* otherwise calling scope can be the debugger */
73void
74CLONE (...)
75 PROTOTYPE: @
76 CODE:
77 guard_stash = gv_stashpv ("Guard", 1);
78 101
79void 102void
80scope_guard (SV *block) 103scope_guard (SV *block)
81 PROTOTYPE: & 104 PROTOTYPE: &
82 CODE: 105 CODE:
… …
87SV * 110SV *
88guard (SV *block) 111guard (SV *block)
89 PROTOTYPE: & 112 PROTOTYPE: &
90 CODE: 113 CODE:
91{ 114{
92 SV *cv = guard_get_cv (aTHX_ block); 115 SV *cv = guard_get_cv (aTHX_ block);
93 SV *guard = NEWSV (0, 0); 116 SV *guard = NEWSV (0, 0);
94 SvUPGRADE (guard, SVt_PVMG); 117 SvUPGRADE (guard, SVt_PVMG);
95 sv_magicext (guard, cv, PERL_MAGIC_ext, &guard_vtbl, 0, 0); 118 sv_magicext (guard, cv, PERL_MAGIC_ext, &guard_vtbl, 0, 0);
96 RETVAL = newRV_noinc (guard); 119 RETVAL = newRV_noinc (guard);
97 SvOBJECT_on (guard); 120 SvOBJECT_on (guard);
121#if !PERL_VERSION_ATLEAST(5,18,0)
98 ++PL_sv_objcount; 122 ++PL_sv_objcount;
123#endif
99 SvSTASH_set (guard, (HV*)SvREFCNT_inc ((SV *)guard_stash)); 124 SvSTASH_set (guard, (HV*)SvREFCNT_inc ((SV *)guard_stash));
100} 125}
101 OUTPUT: 126 OUTPUT:
102 RETVAL 127 RETVAL
103 128

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines