File Coverage

lib/Syntax/Keyword/PhaserExpression.xs
Criterion Covered Total %
statement 22 24 91.6
branch 6 8 75.0
condition n/a
subroutine n/a
pod n/a
total 28 32 87.5


line stmt bran cond sub pod time code
1             /* You may distribute under the terms of either the GNU General Public License
2             * or the Artistic License (the same terms as Perl itself)
3             *
4             * (C) Paul Evans, 2024 -- leonerd@leonerd.org.uk
5             */
6             #include "EXTERN.h"
7             #include "perl.h"
8             #include "XSUB.h"
9              
10             #include "XSParseKeyword.h"
11              
12             #define HAVE_PERL_VERSION(R, V, S) \
13             (PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S))))))
14              
15 43           static bool permit_begin(pTHX_ void *hookdata)
16             {
17             /* Evil hackery. We don't want to take over perl's BEGIN { ... } syntax, so
18             * lets peek to see if the next token is a '{'
19             */
20 43           lex_read_space(0);
21 43 100         if(lex_peek_unichar(0) == '{')
22 39           return false;
23              
24             return true;
25             }
26              
27 4           static int build_begin(pTHX_ OP **out, XSParseKeywordPiece *args[], size_t nargs, void *hookdata)
28             {
29             assert(nargs >= 1);
30 4           OP *expr = args[0]->op;
31              
32 4 100         OP *start = LINKLIST(expr);
33 4           expr->op_next = NULL;
34              
35             /* We CANNOT use an ENTER/LEAVE pair in this function while invoking the
36             * optree. If we do that, then any `my ...` declarations in the expression
37             * will call saveclearsv() inside that scope, which will then get cleared
38             * when we LEAVE, and subsequent code will see an unavailable undef in those
39             * lexical variables.
40             *
41             * It might be nice to find a better solution for that, so that we can use
42             * the SAVE* macros here as normal. But currently it appears to work without
43             * that.
44             */
45              
46             //ENTER;
47             //SAVEVPTR(PL_op);
48 4           PL_op = start;
49              
50             //SAVESPTR(PL_curpad);
51 4           PL_curpad = PadARRAY(PL_comppad);
52              
53 4           U32 mark = PL_stack_sp - PL_stack_base;
54              
55 4           CALLRUNOPS(aTHX);
56              
57 4           U32 height = PL_stack_sp - PL_stack_base - mark;
58 4 50         if(height) {
59             dSP;
60             /* TODO: Think about list-context */
61 4           SV *ret = POPs;
62              
63 4 50         if(height > 1)
64 0           warn("TODO: need to pop %d more items from the staack", height - 1);
65              
66 4           *out = newSVOP(OP_CONST, 0, SvREFCNT_inc(ret));
67             /* Set this flag so it doesn't warn about being useless in void context */
68 4           (*out)->op_private |= OPpCONST_SHORTCIRCUIT;
69 4           PUTBACK;
70             }
71             else
72 0           *out = newOP(OP_NULL, 0);
73              
74             //LEAVE;
75              
76 4           return KEYWORD_PLUGIN_EXPR;
77             }
78              
79             static const struct XSParseKeywordHooks hooks_begin = {
80             .flags = XPK_FLAG_EXPR,
81              
82             .permit = &permit_begin,
83              
84             .pieces = (const struct XSParseKeywordPieceType[]){
85             XPK_TERMEXPR,
86             0,
87             },
88             .build = &build_begin,
89             };
90              
91             MODULE = Syntax::Keyword::PhaserExpression PACKAGE = Syntax::Keyword::PhaserExpression
92              
93             BOOT:
94 2           boot_xs_parse_keyword(0.13);
95              
96 2           register_xs_parse_keyword("BEGIN", &hooks_begin, NULL);