File Coverage

hax/optree-additions.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 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, flags, padix) S_newPADxVOP(aTHX_ type, flags, padix)
20             static OP *S_newPADxVOP(pTHX_ I32 type, I32 flags, PADOFFSET padix)
21             {
22             OP *op = newOP(type, flags);
23             op->op_targ = padix;
24             return op;
25             }
26              
27             #if HAVE_PERL_VERSION(5, 22, 0)
28             # define HAVE_UNOP_AUX
29             #endif
30              
31             #ifndef HAVE_UNOP_AUX
32             typedef struct UNOP_with_IV {
33             UNOP baseop;
34             IV iv;
35             } UNOP_with_IV;
36              
37             #define newUNOP_with_IV(type, flags, first, iv) S_newUNOP_with_IV(aTHX_ type, flags, first, iv)
38             static OP *S_newUNOP_with_IV(pTHX_ I32 type, I32 flags, OP *first, IV iv)
39             {
40             /* Cargoculted from perl's op.c:Perl_newUNOP()
41             */
42             UNOP_with_IV *op = PerlMemShared_malloc(sizeof(UNOP_with_IV) * 1);
43             NewOp(1101, op, 1, UNOP_with_IV);
44              
45             if(!first)
46             first = newOP(OP_STUB, 0);
47             UNOP *unop = (UNOP *)op;
48             unop->op_type = (OPCODE)type;
49             unop->op_first = first;
50             unop->op_ppaddr = NULL;
51             unop->op_flags = (U8)flags | OPf_KIDS;
52             unop->op_private = (U8)(1 | (flags >> 8));
53              
54             op->iv = iv;
55              
56             return (OP *)op;
57             }
58             #endif
59              
60             #define newMETHOD_REDIR_OP(rclass, methname, flags) S_newMETHOD_REDIR_OP(aTHX_ rclass, methname, flags)
61             static OP *S_newMETHOD_REDIR_OP(pTHX_ SV *rclass, SV *methname, I32 flags)
62             {
63             #if HAVE_PERL_VERSION(5, 22, 0)
64             OP *op = newMETHOP_named(OP_METHOD_REDIR, flags, methname);
65             # ifdef USE_ITHREADS
66             {
67             /* cargoculted from S_op_relocate_sv() */
68             PADOFFSET ix = pad_alloc(OP_CONST, SVf_READONLY);
69             PAD_SETSV(ix, rclass);
70             cMETHOPx(op)->op_rclass_targ = ix;
71             }
72             # else
73             cMETHOPx(op)->op_rclass_sv = rclass;
74             # endif
75             #else
76             OP *op = newUNOP(OP_METHOD, flags,
77             newSVOP(OP_CONST, 0, newSVpvf("%" SVf "::%" SVf, rclass, methname)));
78             #endif
79              
80             return op;
81             }
82              
83             /* If `@_` is called "snail", then elements of it can be called "slugs"; i.e.
84             * snails without their container
85             */
86             #define newSLUGOP(idx) S_newSLUGOP(aTHX_ idx)
87             static OP *S_newSLUGOP(pTHX_ int idx)
88             {
89 6           OP *op = newGVOP(OP_AELEMFAST, 0, PL_defgv);
90 8           op->op_private = idx;
91             return op;
92             }