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

Comparing Guard/Guard.xs (file contents):
Revision 1.2 by root, Sat Dec 13 17:49:12 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
23
24static HV *guard_stash;
6 25
7static SV * 26static SV *
8guard_get_cv (pTHX_ SV *cb_sv) 27guard_get_cv (pTHX_ SV *cb_sv)
9{ 28{
10 HV *st; 29 HV *st;
… …
20static void 39static void
21exec_guard_cb (pTHX_ SV *cb) 40exec_guard_cb (pTHX_ SV *cb)
22{ 41{
23 dSP; 42 dSP;
24 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;
25 47
26 PUSHSTACKi (PERLSI_DESTROY); 48 PUSHSTACKi (PERLSI_DESTROY);
27 49
28 PUSHMARK (SP); 50 PUSHMARK (SP);
29 PUTBACK; 51 PUTBACK;
30 call_sv (cb, G_VOID | G_DISCARD | G_EVAL); 52 call_sv (cb, G_VOID | G_DISCARD | G_EVAL);
31 SPAGAIN;
32 53
33 if (SvTRUE (ERRSV)) 54 if (SvTRUE (ERRSV))
34 { 55 {
56 SPAGAIN;
57
35 PUSHMARK (SP); 58 PUSHMARK (SP);
36 PUTBACK; 59 PUTBACK;
37 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);
38 SPAGAIN;
39 61
40 sv_setsv (ERRSV, &PL_sv_undef); 62 sv_setpvn (ERRSV, "", 0);
41 } 63 }
42 64
43 if (saveerr) 65 if (saveerr)
44 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 }
45 73
46 POPSTACK; 74 POPSTACK;
47} 75}
48 76
49static void 77static void
… …
54 82
55static int 83static int
56guard_free (pTHX_ SV *cv, MAGIC *mg) 84guard_free (pTHX_ SV *cv, MAGIC *mg)
57{ 85{
58 exec_guard_cb (aTHX_ mg->mg_obj); 86 exec_guard_cb (aTHX_ mg->mg_obj);
87
88 return 0;
59} 89}
60 90
61static MGVTBL guard_vtbl = { 91static MGVTBL guard_vtbl = {
62 0, 0, 0, 0, 92 0, 0, 0, 0,
63 guard_free 93 guard_free
64}; 94};
65 95
66MODULE = Guard PACKAGE = Guard 96MODULE = Guard PACKAGE = Guard
97
98BOOT:
99 guard_stash = gv_stashpv ("Guard", 1);
100 CvNODEBUG_on (get_cv ("Guard::scope_guard", 0)); /* otherwise calling scope can be the debugger */
67 101
68void 102void
69scope_guard (SV *block) 103scope_guard (SV *block)
70 PROTOTYPE: & 104 PROTOTYPE: &
71 CODE: 105 CODE:
… …
76SV * 110SV *
77guard (SV *block) 111guard (SV *block)
78 PROTOTYPE: & 112 PROTOTYPE: &
79 CODE: 113 CODE:
80{ 114{
81 SV *cv = guard_get_cv (aTHX_ block); 115 SV *cv = guard_get_cv (aTHX_ block);
82 SV *guard = NEWSV (0, 0); 116 SV *guard = NEWSV (0, 0);
83 SvUPGRADE (guard, SVt_PVMG); 117 SvUPGRADE (guard, SVt_PVMG);
84 sv_magicext (guard, cv, PERL_MAGIC_ext, &guard_vtbl, 0, 0); 118 sv_magicext (guard, cv, PERL_MAGIC_ext, &guard_vtbl, 0, 0);
85 RETVAL = newRV_noinc (guard); 119 RETVAL = newRV_noinc (guard);
120 SvOBJECT_on (guard);
121#if !PERL_VERSION_ATLEAST(5,18,0)
122 ++PL_sv_objcount;
123#endif
124 SvSTASH_set (guard, (HV*)SvREFCNT_inc ((SV *)guard_stash));
86} 125}
87 OUTPUT: 126 OUTPUT:
88 RETVAL 127 RETVAL
89 128
90void 129void

Diff Legend

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