File Coverage

hax/optree-additions.c.inc
Criterion Covered Total %
statement 3 3 100.0
branch n/a
condition n/a
subroutine n/a
pod n/a
total 3 3 100.0


line stmt bran cond sub pod time code
1             /* vi: set ft=c : */
2              
3             #define newAELEMOP(flags, first, key) S_newAELEMOP(aTHX_ flags, first, key)
4             static OP *S_newAELEMOP(pTHX_ U32 flags, OP *first, I32 key)
5             {
6             #if HAVE_PERL_VERSION(5,16,0)
7             if(key >= -128 && key < 128 && first->op_type == OP_PADAV) {
8             OP *o = newOP(OP_AELEMFAST_LEX, flags);
9             o->op_private = (I8)key;
10             o->op_targ = first->op_targ;
11             op_free(first);
12             return o;
13             }
14             #endif
15              
16             return newBINOP(OP_AELEM, flags, first, newSVOP(OP_CONST, 0, newSViv(key)));
17             }
18              
19             #define newPADxVOP(type, padix, flags, private) S_newPADxVOP(aTHX_ type, padix, flags, private)
20             static OP *S_newPADxVOP(pTHX_ I32 type, PADOFFSET padix, I32 flags, U32 private)
21             {
22 39           OP *op = newOP(type, flags);
23 39           op->op_targ = padix;
24 39           op->op_private = private;
25             return op;
26             }
27              
28             #if HAVE_PERL_VERSION(5, 22, 0)
29             # define HAVE_UNOP_AUX
30             #endif
31              
32             #ifndef HAVE_UNOP_AUX
33             typedef struct UNOP_with_IV {
34             UNOP baseop;
35             IV iv;
36             } UNOP_with_IV;
37              
38             #define newUNOP_with_IV(type, flags, first, iv) S_newUNOP_with_IV(aTHX_ type, flags, first, iv)
39             static OP *S_newUNOP_with_IV(pTHX_ I32 type, I32 flags, OP *first, IV iv)
40             {
41             /* Cargoculted from perl's op.c:Perl_newUNOP()
42             */
43             UNOP_with_IV *op = PerlMemShared_malloc(sizeof(UNOP_with_IV) * 1);
44             NewOp(1101, op, 1, UNOP_with_IV);
45              
46             if(!first)
47             first = newOP(OP_STUB, 0);
48             UNOP *unop = (UNOP *)op;
49             unop->op_type = (OPCODE)type;
50             unop->op_first = first;
51             unop->op_ppaddr = NULL;
52             unop->op_flags = (U8)flags | OPf_KIDS;
53             unop->op_private = (U8)(1 | (flags >> 8));
54              
55             op->iv = iv;
56              
57             return (OP *)op;
58             }
59             #endif
60              
61             #define newMETHOD_REDIR_OP(rclass, methname, flags) S_newMETHOD_REDIR_OP(aTHX_ rclass, methname, flags)
62             static OP *S_newMETHOD_REDIR_OP(pTHX_ SV *rclass, SV *methname, I32 flags)
63             {
64             #if HAVE_PERL_VERSION(5, 22, 0)
65             OP *op = newMETHOP_named(OP_METHOD_REDIR, flags, methname);
66             # ifdef USE_ITHREADS
67             {
68             /* cargoculted from S_op_relocate_sv() */
69             PADOFFSET ix = pad_alloc(OP_CONST, SVf_READONLY);
70             PAD_SETSV(ix, rclass);
71             cMETHOPx(op)->op_rclass_targ = ix;
72             }
73             # else
74             cMETHOPx(op)->op_rclass_sv = rclass;
75             # endif
76             #else
77             OP *op = newUNOP(OP_METHOD, flags,
78             newSVOP(OP_CONST, 0, newSVpvf("%" SVf "::%" SVf, rclass, methname)));
79             #endif
80              
81             return op;
82             }