File Coverage

EqualityInsensitive.xs
Criterion Covered Total %
statement 40 40 100.0
branch 2 4 50.0
condition n/a
subroutine n/a
pod n/a
total 42 44 95.4


line stmt bran cond sub pod time code
1             #include "EXTERN.h"
2             #include "perl.h"
3             #include "XSUB.h"
4             #include "ppport.h"
5              
6             static XOP eqi_xop;
7             static XOP nei_xop;
8              
9             static OP *
10 23           pp_eqi(pTHX)
11             {
12 23           dSP;
13 23           SV *b = POPs;
14 23           SV *a = TOPs;
15             const char *sa, *sb;
16             STRLEN la, lb;
17             I32 result;
18              
19 23           sv_utf8_upgrade(a);
20 23           sv_utf8_upgrade(b);
21 23           sa = SvPVutf8(a, la);
22 23           sb = SvPVutf8(b, lb);
23 23           result = foldEQ_utf8(sa, NULL, (IV)la, TRUE,
24             sb, NULL, (IV)lb, TRUE);
25 23           SETs(sv_2mortal(newSViv(result ? 1 : 0)));
26 23           RETURN;
27             }
28              
29             static OP *
30 10           pp_nei(pTHX)
31             {
32 10           dSP;
33 10           SV *b = POPs;
34 10           SV *a = TOPs;
35             const char *sa, *sb;
36             STRLEN la, lb;
37             I32 result;
38              
39 10           sv_utf8_upgrade(a);
40 10           sv_utf8_upgrade(b);
41 10           sa = SvPVutf8(a, la);
42 10           sb = SvPVutf8(b, lb);
43 10           result = foldEQ_utf8(sa, NULL, (IV)la, TRUE,
44             sb, NULL, (IV)lb, TRUE);
45 10           SETs(sv_2mortal(newSViv(result ? 0 : 1)));
46 10           RETURN;
47             }
48              
49             static OP *
50 23           eqi_build_op(pTHX_ SV **opdata, OP *lhs, OP *rhs,
51             struct Perl_custom_infix *def)
52             {
53             OP *o;
54             PERL_UNUSED_ARG(opdata);
55             PERL_UNUSED_ARG(def);
56 23           o = newBINOP(OP_CUSTOM, 0, lhs, rhs);
57 23           o->op_ppaddr = pp_eqi;
58 23           return o;
59             }
60              
61             static OP *
62 10           nei_build_op(pTHX_ SV **opdata, OP *lhs, OP *rhs,
63             struct Perl_custom_infix *def)
64             {
65             OP *o;
66             PERL_UNUSED_ARG(opdata);
67             PERL_UNUSED_ARG(def);
68 10           o = newBINOP(OP_CUSTOM, 0, lhs, rhs);
69 10           o->op_ppaddr = pp_nei;
70 10           return o;
71             }
72              
73             MODULE = Syntax::Infix::EqualityInsensitive PACKAGE = Syntax::Infix::EqualityInsensitive
74              
75             BOOT:
76 2           XopENTRY_set(&eqi_xop, xop_name, "eqi");
77 2           XopENTRY_set(&eqi_xop, xop_desc, "case-insensitive string equality");
78 2           XopENTRY_set(&eqi_xop, xop_class, OA_BINOP);
79 2           Perl_custom_op_register(aTHX_ pp_eqi, &eqi_xop);
80              
81 2           XopENTRY_set(&nei_xop, xop_name, "nei");
82 2           XopENTRY_set(&nei_xop, xop_desc, "case-insensitive string inequality");
83 2           XopENTRY_set(&nei_xop, xop_class, OA_BINOP);
84 2           Perl_custom_op_register(aTHX_ pp_nei, &nei_xop);
85              
86             IV
87             _eqi_build_op_addr()
88             CODE:
89 1 50         RETVAL = PTR2IV(eqi_build_op);
90             OUTPUT:
91             RETVAL
92              
93             IV
94             _nei_build_op_addr()
95             CODE:
96 1 50         RETVAL = PTR2IV(nei_build_op);
97             OUTPUT:
98             RETVAL