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))))) |
6 | |
14 | |
7 | /* apparently < 5.8.8 */ |
15 | /* apparently < 5.8.8 */ |
8 | #ifndef SvSTASH_set |
16 | #ifndef SvSTASH_set |
9 | # define SvSTASH_set(x,a) SvSTASH(x) = (a) |
17 | # define SvSTASH_set(x,a) SvSTASH(x) = (a) |
10 | #endif |
18 | #endif |
… | |
… | |
102 | SV * |
110 | SV * |
103 | guard (SV *block) |
111 | guard (SV *block) |
104 | PROTOTYPE: & |
112 | PROTOTYPE: & |
105 | CODE: |
113 | CODE: |
106 | { |
114 | { |
107 | SV *cv = guard_get_cv (aTHX_ block); |
115 | SV *cv = guard_get_cv (aTHX_ block); |
108 | SV *guard = NEWSV (0, 0); |
116 | SV *guard = NEWSV (0, 0); |
109 | SvUPGRADE (guard, SVt_PVMG); |
117 | SvUPGRADE (guard, SVt_PVMG); |
110 | sv_magicext (guard, cv, PERL_MAGIC_ext, &guard_vtbl, 0, 0); |
118 | sv_magicext (guard, cv, PERL_MAGIC_ext, &guard_vtbl, 0, 0); |
111 | RETVAL = newRV_noinc (guard); |
119 | RETVAL = newRV_noinc (guard); |
112 | SvOBJECT_on (guard); |
120 | SvOBJECT_on (guard); |
|
|
121 | #if !PERL_VERSION_ATLEAST(5,18,0) |
113 | ++PL_sv_objcount; |
122 | ++PL_sv_objcount; |
|
|
123 | #endif |
114 | SvSTASH_set (guard, (HV*)SvREFCNT_inc ((SV *)guard_stash)); |
124 | SvSTASH_set (guard, (HV*)SvREFCNT_inc ((SV *)guard_stash)); |
115 | } |
125 | } |
116 | OUTPUT: |
126 | OUTPUT: |
117 | RETVAL |
127 | RETVAL |
118 | |
128 | |