File Coverage

t/infix.xs

Criterion	Covered	Total	%
statement	38	47	80.8
branch	12	24	50.0
condition			n/a
subroutine			n/a
pod			n/a
total	50	71	70.4

line	stmt	bran	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, 2021 -- leonerd@leonerd.org.uk
5			*/
6
7			#include "EXTERN.h"
8			#include "perl.h"
9			#include "XSUB.h"
10
11			#include "XSParseInfix.h"
12
13			#include "perl-backcompat.c.inc"
14
15			static const char hintkey[] = "t::infix/permit";
16
17			XOP xop_add;
18
19	2		OP *pp_add(pTHX)
20			{
21	2		dSP;
22	2		SV *right = POPs;
23	2		SV *left = POPs;
24	2	50	mPUSHi(SvIV(left) + SvIV(right));
		50
25	2		RETURN;
26			}
27
28			static const struct XSParseInfixHooks hooks_add = {
29			.cls = XPI_CLS_ADD_MISC,
30			.permit_hintkey = hintkey,
31
32			.wrapper_func_name = "t::infix::addfunc",
33
34			.ppaddr = &pp_add,
35			};
36
37	0		OP *pp_mul(pTHX)
38			{
39	0		croak("TODO"); /* We never actually call code with this so it doesn't matter */
40			}
41
42			static const struct XSParseInfixHooks hooks_mul = {
43			.cls = XPI_CLS_MUL_MISC,
44			.permit_hintkey = hintkey,
45
46			.ppaddr = &pp_mul,
47			};
48
49	0		OP *pp_xor(pTHX)
50			{
51	0		dSP;
52	0		SV *right = POPs;
53	0		SV *left = POPs;
54	0	0	mPUSHi(SvIV(left) ^ SvIV(right));
		0
55	0		RETURN;
56			}
57
58			static const struct XSParseInfixHooks hooks_xor = {
59			.cls = XPI_CLS_ADD_MISC,
60			.permit_hintkey = hintkey,
61
62			.ppaddr = &pp_xor,
63			};
64
65	1		OP *pp_intersperse(pTHX)
66			{
67			/* This isn't a very efficient implementation but we're not going for
68			* efficiency here in this unit test
69			*/
70	1		dSP;
71			I32 markidx = POPMARK;
72	1		I32 items = SP - PL_stack_base - markidx;
73
74	1		SP -= items;
75	1		SV sep = SP;
76
77	1		AV *list = av_make(items, SP+1);
78	1		SAVEFREESV((SV *)list);
79
80	1		SP--;
81
82	1	50	if(!items)
83	0		RETURN;
84
85	1	50	EXTEND(SP, 2*items - 1);
		50
86	1		PUSHs(*av_fetch(list, 0, TRUE));
87
88			I32 i;
89	2	100	for(i = 1; i < items; i++) {
90	1		PUSHs(sv_mortalcopy(sep));
91	1		PUSHs(*av_fetch(list, i, TRUE));
92			}
93	1		RETURN;
94			}
95
96			static const struct XSParseInfixHooks hooks_intersperse = {
97			.cls = XPI_CLS_ADD_MISC,
98			.rhs_flags = XPI_OPERAND_LIST,
99			.permit_hintkey = hintkey,
100
101			.wrapper_func_name = "t::infix::interspersefunc",
102
103			.ppaddr = &pp_intersperse,
104			};
105
106	8		OP *pp_addpairs(pTHX)
107			{
108	8		dSP;
109	8		U32 rhs_mark = POPMARK;
110	8		U32 lhs_mark = POPMARK;
111
112	8		U32 rhs_count = SP - (PL_stack_base + rhs_mark);
113	8		U32 lhs_count = rhs_mark - lhs_mark;
114
115	8		SP = PL_stack_base + lhs_mark;
116
117	8		SV **lhs = PL_stack_base + lhs_mark + 1;
118	8		SV **rhs = PL_stack_base + rhs_mark + 1;
119
120	8	50	PUSHMARK(SP);
121
122	31	100	while(lhs_count \|\| rhs_count) {
123	23	50	IV val = SvIV(lhs) + SvIV(rhs);
		50
124	23		mPUSHi(val);
125
126	23		lhs++; lhs_count--;
127	23		rhs++; rhs_count--;
128			}
129
130	8		RETURN;
131			}
132
133			static const struct XSParseInfixHooks hooks_addpairs = {
134			.cls = XPI_CLS_ADD_MISC,
135			.lhs_flags = XPI_OPERAND_LIST,
136			.rhs_flags = XPI_OPERAND_LIST\|XPI_OPERAND_ONLY_LOOK, /* only on RHS so we can test the logic */
137			.permit_hintkey = hintkey,
138
139			.wrapper_func_name = "t::infix::addpairsfunc",
140
141			.ppaddr = &pp_addpairs,
142			};
143
144			MODULE = t::infix PACKAGE = t::infix
145
146			BOOT:
147	2		boot_xs_parse_infix(0);
148
149			register_xs_parse_infix("add", &hooks_add, NULL);
150			register_xs_parse_infix("mul", &hooks_mul, NULL);
151
152			register_xs_parse_infix("⊕", &hooks_xor, NULL);
153
154			register_xs_parse_infix("intersperse", &hooks_intersperse, NULL);
155
156			register_xs_parse_infix("addpairs", &hooks_addpairs, NULL);