| 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 | |
