File Coverage

hax/newOP_CUSTOM.c.inc
Criterion Covered Total %
statement 6 6 100.0
branch n/a
condition n/a
subroutine n/a
pod n/a
total 6 6 100.0


line stmt bran cond sub pod time code
1             /* vi: set ft=c : */
2              
3             /* Before perl 5.22 under -DDEBUGGING, various new*OP() functions throw assert
4             * failures on OP_CUSTOM.
5             * https://rt.cpan.org/Ticket/Display.html?id=128562
6             */
7              
8             #define newOP_CUSTOM(func, flags) S_newOP_CUSTOM(aTHX_ func, flags)
9             #define newUNOP_CUSTOM(func, flags, first) S_newUNOP_CUSTOM(aTHX_ func, flags, first)
10             #define newSVOP_CUSTOM(func, flags, sv) S_newSVOP_CUSTOM(aTHX_ func, flags, sv)
11             #define newBINOP_CUSTOM(func, flags, first, last) S_newBINOP_CUSTOM(aTHX_ func, flags, first, last)
12             #define newLOGOP_CUSTOM(func, flags, first, other) S_newLOGOP_CUSTOM(aTHX_ func, flags, first, other)
13              
14             static OP *S_newOP_CUSTOM(pTHX_ OP *(*func)(pTHX), U32 flags)
15             {
16 103           OP *op = newOP(OP_CUSTOM, flags);
17 103           op->op_ppaddr = func;
18             return op;
19             }
20              
21             static OP *S_newUNOP_CUSTOM(pTHX_ OP *(*func)(pTHX), U32 flags, OP *first)
22             {
23             UNOP *unop;
24             #if HAVE_PERL_VERSION(5,22,0)
25 94           unop = (UNOP *)newUNOP(OP_CUSTOM, flags, first);
26             #else
27             NewOp(1101, unop, 1, UNOP);
28             unop->op_type = (OPCODE)OP_CUSTOM;
29             unop->op_first = first;
30             unop->op_flags = (U8)(flags | OPf_KIDS);
31             unop->op_private = (U8)(1 | (flags >> 8));
32             #endif
33 94           unop->op_ppaddr = func;
34             return (OP *)unop;
35             }
36              
37             static OP *S_newSVOP_CUSTOM(pTHX_ OP *(*func)(pTHX), U32 flags, SV *sv)
38             {
39             SVOP *svop;
40             #if HAVE_PERL_VERSION(5,22,0)
41 4           svop = (SVOP *)newSVOP(OP_CUSTOM, flags, sv);
42             #else
43             NewOp(1101, svop, 1, SVOP);
44             svop->op_type = (OPCODE)OP_CUSTOM;
45             svop->op_sv = sv;
46             svop->op_next = (OP *)svop;
47             svop->op_flags = 0;
48             svop->op_private = 0;
49             #endif
50 4           svop->op_ppaddr = func;
51             return (OP *)svop;
52             }
53              
54             static OP *S_newBINOP_CUSTOM(pTHX_ OP *(*func)(pTHX), U32 flags, OP *first, OP *last)
55             {
56             BINOP *binop;
57             #if HAVE_PERL_VERSION(5,22,0)
58             binop = (BINOP *)newBINOP(OP_CUSTOM, flags, first, last);
59             #else
60             NewOp(1101, binop, 1, BINOP);
61             binop->op_type = (OPCODE)OP_CUSTOM;
62             binop->op_first = first;
63             first->op_sibling = last;
64             binop->op_last = last;
65             binop->op_flags = (U8)(flags | OPf_KIDS);
66             binop->op_private = (U8)(2 | (flags >> 8));
67             #endif
68             binop->op_ppaddr = func;
69             return (OP *)binop;
70             }
71              
72             static OP *S_newLOGOP_CUSTOM(pTHX_ OP *(*func)(pTHX), U32 flags, OP *first, OP *other)
73             {
74             OP *o;
75             #if HAVE_PERL_VERSION(5,22,0)
76             o = newLOGOP(OP_CUSTOM, flags, first, other);
77             #else
78             /* Parts of this code copypasted from perl 5.20.0's op.c S_new_logop()
79             */
80             LOGOP *logop;
81              
82             first = op_contextualize(first, G_SCALAR);
83              
84             NewOp(1101, logop, 1, LOGOP);
85              
86             logop->op_type = (OPCODE)OP_CUSTOM;
87             logop->op_ppaddr = NULL; /* Because caller only overrides it anyway */
88             logop->op_first = first;
89             logop->op_flags = (U8)(flags | OPf_KIDS);
90             logop->op_other = LINKLIST(other);
91             /* logop->op_private has nothing interesting for OP_CUSTOM */
92              
93             /* Link in postfix order */
94             logop->op_next = LINKLIST(first);
95             first->op_next = (OP *)logop;
96             first->op_sibling = other;
97              
98             /* No CHECKOP for OP_CUSTOM */
99             o = newUNOP(OP_NULL, 0, (OP *)logop);
100             other->op_next = o;
101             #endif
102              
103             /* the returned op is actually an UNOP that's either NULL or NOT; the real
104             * logop is the op_next of it
105             */
106             cUNOPx(o)->op_first->op_ppaddr = func;
107              
108             return o;
109             }