File Coverage

hax/perl-backcompat.c.inc
Criterion Covered Total %
statement 2 2 100.0
branch n/a
condition n/a
subroutine n/a
pod n/a
total 2 2 100.0


line stmt bran cond sub pod time code
1             /* vi: set ft=c : */
2              
3             #define HAVE_PERL_VERSION(R, V, S) \
4             (PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S))))))
5              
6             #ifndef NOT_REACHED
7             # define NOT_REACHED assert(0)
8             #endif
9              
10             #ifndef SvTRUE_NN
11             # define SvTRUE_NN(sv) SvTRUE(sv)
12             #endif
13              
14             #ifndef G_LIST
15             # define G_LIST G_ARRAY
16             #endif
17              
18             #if !HAVE_PERL_VERSION(5, 18, 0)
19             typedef AV PADNAMELIST;
20             # define PadlistARRAY(pl) ((PAD **)AvARRAY(pl))
21             # define PadlistNAMES(pl) (*PadlistARRAY(pl))
22              
23             typedef SV PADNAME;
24             # define PadnamePV(pn) (SvPOKp(pn) ? SvPVX(pn) : NULL)
25             # define PadnameLEN(pn) SvCUR(pn)
26             # define PadnameIsSTATE(pn) (!!SvPAD_STATE(pn))
27             # define PadnameOUTER(pn) (SvFAKE(pn) && !SvPAD_STATE(pn))
28             # define PadnamelistARRAY(pnl) AvARRAY(pnl)
29             # define PadnamelistMAX(pnl) AvFILLp(pnl)
30              
31             # define PadARRAY(p) AvARRAY(p)
32             # define PadMAX(pad) AvFILLp(pad)
33             #endif
34              
35             #if !HAVE_PERL_VERSION(5, 22, 0)
36             # define CvPADLIST_set(cv, padlist) (CvPADLIST(cv) = padlist)
37             # define newPADNAMEpvn(p,n) S_newPADNAMEpvn(aTHX_ p,n)
38             static PADNAME *S_newPADNAMEpvn(pTHX_ const char *pv, STRLEN n)
39             {
40             PADNAME *pn = newSVpvn(pv, n);
41             /* PADNAMEs need to be at least SVt_PVNV in order to store the COP_SEQ_*
42             * fields */
43             sv_upgrade(pn, SVt_PVNV);
44             return pn;
45             }
46             # define PadnameREFCNT_dec(pn) SvREFCNT_dec(pn)
47             #endif
48              
49             #ifndef av_count
50             # define av_count(av) (AvFILL(av) + 1)
51             #endif
52              
53             #ifndef av_top_index
54             # define av_top_index(av) AvFILL(av)
55             #endif
56              
57             #ifndef block_end
58             # define block_end(a,b) Perl_block_end(aTHX_ a,b)
59             #endif
60              
61             #ifndef block_start
62             # define block_start(a) Perl_block_start(aTHX_ a)
63             #endif
64              
65             #ifndef cophh_exists_pvs
66             # define cophh_exists_pvs(a,b,c) cBOOL(cophh_fetch_pvs(a,b,c))
67             #endif
68              
69             #ifndef cv_clone
70             # define cv_clone(a) Perl_cv_clone(aTHX_ a)
71             #endif
72              
73             #ifndef intro_my
74             # define intro_my() Perl_intro_my(aTHX)
75             #endif
76              
77             #ifndef pad_alloc
78             # define pad_alloc(a,b) Perl_pad_alloc(aTHX_ a,b)
79             #endif
80              
81             #ifndef CX_CUR
82             # define CX_CUR() (&cxstack[cxstack_ix])
83             #endif
84              
85             #if HAVE_PERL_VERSION(5, 24, 0)
86             # define OLDSAVEIX(cx) (cx->blk_oldsaveix)
87             #else
88             # define OLDSAVEIX(cx) (PL_scopestack[cx->blk_oldscopesp-1])
89             #endif
90              
91             #ifndef OpSIBLING
92             # define OpSIBLING(op) ((op)->op_sibling)
93             #endif
94              
95             #ifndef OpHAS_SIBLING
96             # define OpHAS_SIBLING(op) (cBOOL(OpSIBLING(op)))
97             #endif
98              
99             #ifndef OpMORESIB_set
100             # define OpMORESIB_set(op,sib) ((op)->op_sibling = (sib))
101             #endif
102              
103             #ifndef OpLASTSIB_set
104             /* older perls don't need to store this at all */
105             # define OpLASTSIB_set(op,parent)
106             #endif
107              
108             #ifndef op_convert_list
109             # define op_convert_list(type, flags, o) S_op_convert_list(aTHX_ type, flags, o)
110             static OP *S_op_convert_list(pTHX_ I32 type, I32 flags, OP *o)
111             {
112             /* A minimal recreation just for our purposes */
113             assert(
114             /* A hardcoded list of the optypes we know this will work for */
115             type == OP_ENTERSUB ||
116             type == OP_JOIN ||
117             type == OP_PUSH ||
118             0);
119              
120             o->op_type = type;
121             o->op_flags |= flags;
122             o->op_ppaddr = PL_ppaddr[type];
123              
124             o = PL_check[type](aTHX_ o);
125              
126             /* op_std_init() */
127             if(PL_opargs[type] & OA_RETSCALAR)
128             o = op_contextualize(o, G_SCALAR);
129             if(PL_opargs[type] & OA_TARGET && !o->op_targ)
130             o->op_targ = pad_alloc(type, SVs_PADTMP);
131              
132             return o;
133             }
134             #endif
135              
136             #ifndef newMETHOP_named
137             # define newMETHOP_named(type, flags, name) newSVOP(type, flags, name)
138             #endif
139              
140             #ifndef PARENT_PAD_INDEX_set
141             # if HAVE_PERL_VERSION(5, 22, 0)
142             # define PARENT_PAD_INDEX_set(pn,val) (PARENT_PAD_INDEX(pn) = val)
143             # else
144             /* stolen from perl-5.20.0's pad.c */
145             # define PARENT_PAD_INDEX_set(sv,val) \
146             STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xlow = (val); } STMT_END
147             # endif
148             #endif
149              
150             /* On Perl 5.14 this had a different name */
151             #ifndef pad_add_name_pvn
152             #define pad_add_name_pvn(name, len, flags, typestash, ourstash) MY_pad_add_name(aTHX_ name, len, flags, typestash, ourstash)
153             static PADOFFSET MY_pad_add_name(pTHX_ const char *name, STRLEN len, U32 flags, HV *typestash, HV *ourstash)
154             {
155             /* perl 5.14's Perl_pad_add_name requires a NUL-terminated name */
156             SV *namesv = sv_2mortal(newSVpvn(name, len));
157              
158             return Perl_pad_add_name(aTHX_ SvPV_nolen(namesv), SvCUR(namesv), flags, typestash, ourstash);
159             }
160             #endif
161              
162             #if !HAVE_PERL_VERSION(5, 26, 0)
163             # define isIDFIRST_utf8_safe(s, e) (PERL_UNUSED_ARG(e), isIDFIRST_utf8(s))
164             # define isIDCONT_utf8_safe(s, e) (PERL_UNUSED_ARG(e), isIDCONT_utf8(s))
165             #endif
166              
167             #ifndef CXp_EVALBLOCK
168             /* before perl 5.34 this was called CXp_TRYBLOCK */
169             # define CXp_EVALBLOCK CXp_TRYBLOCK
170             #endif
171              
172             #if !HAVE_PERL_VERSION(5, 26, 0)
173             # define sv_set_undef(sv) sv_setsv(sv, &PL_sv_undef)
174             #endif
175              
176             #ifndef newAVav
177             # define newAVav(av) S_newAVav(aTHX_ av)
178             static AV *S_newAVav(pTHX_ AV *av)
179             {
180             AV *ret = newAV();
181             U32 count = av_count(av);
182             U32 i;
183             for(i = 0; i < count; i++)
184             av_push(ret, newSVsv(AvARRAY(av)[i]));
185             return ret;
186             }
187             #endif
188              
189             #if !defined(sv_derived_from_hv) && HAVE_PERL_VERSION(5, 16, 0)
190             # define sv_derived_from_hv(sv, hv) MY_sv_derived_from_hv(aTHX_ sv, hv)
191             static bool MY_sv_derived_from_hv(pTHX_ SV *sv, HV *hv)
192             {
193             char *hvname = HvNAME(hv);
194             if(!hvname)
195             return FALSE;
196              
197             return sv_derived_from_pvn(sv, hvname, HvNAMELEN(hv), HvNAMEUTF8(hv) ? SVf_UTF8 : 0);
198             }
199             #endif
200              
201             #ifndef xV_FROM_REF
202             # ifdef PERL_USE_GCC_BRACE_GROUPS
203             # define xV_FROM_REF(XV, ref) \
204             ({ SV *_ref = ref; assert(SvROK(_ref)); assert(SvTYPE(SvRV(_ref)) == SVt_PV ## XV); (XV *)(SvRV(_ref)); })
205             # else
206             # define xV_FROM_REF(XV, ref) ((XV *)SvRV(ref))
207             # endif
208              
209             # define AV_FROM_REF(ref) xV_FROM_REF(AV, ref)
210             # define CV_FROM_REF(ref) xV_FROM_REF(CV, ref)
211             # define HV_FROM_REF(ref) xV_FROM_REF(HV, ref)
212             #endif
213              
214             #ifndef newPADxVOP
215             # define newPADxVOP(type, flags, padix) S_newPADxVOP(aTHX_ type, flags, padix)
216             static OP *S_newPADxVOP(pTHX_ I32 type, I32 flags, PADOFFSET padix)
217             {
218 39           OP *op = newOP(type, flags);
219 39           op->op_targ = padix;
220             return op;
221             }
222             #endif