File Coverage

EqualityInsensitive.xs
Criterion Covered Total %
statement 44 44 100.0
branch 2 4 50.0
condition n/a
subroutine n/a
pod n/a
total 46 48 95.8


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           char *ea = (char *)(sa + la);
24 23           char *eb = (char *)(sb + lb);
25 23           result = foldEQ_utf8(sa, &ea, (UV)la, TRUE,
26             sb, &eb, (UV)lb, TRUE);
27 23           SETs(sv_2mortal(newSViv(result ? 1 : 0)));
28 23           RETURN;
29             }
30              
31             static OP *
32 10           pp_nei(pTHX)
33             {
34 10           dSP;
35 10           SV *b = POPs;
36 10           SV *a = TOPs;
37             const char *sa, *sb;
38             STRLEN la, lb;
39             I32 result;
40              
41 10           sv_utf8_upgrade(a);
42 10           sv_utf8_upgrade(b);
43 10           sa = SvPVutf8(a, la);
44 10           sb = SvPVutf8(b, lb);
45 10           char *ea = (char *)(sa + la);
46 10           char *eb = (char *)(sb + lb);
47 10           result = foldEQ_utf8(sa, &ea, (UV)la, TRUE,
48             sb, &eb, (UV)lb, TRUE);
49 10           SETs(sv_2mortal(newSViv(result ? 0 : 1)));
50 10           RETURN;
51             }
52              
53             static OP *
54 23           eqi_build_op(pTHX_ SV **opdata, OP *lhs, OP *rhs,
55             struct Perl_custom_infix *def)
56             {
57             OP *o;
58             PERL_UNUSED_ARG(opdata);
59             PERL_UNUSED_ARG(def);
60 23           o = newBINOP(OP_CUSTOM, 0, lhs, rhs);
61 23           o->op_ppaddr = pp_eqi;
62 23           return o;
63             }
64              
65             static OP *
66 10           nei_build_op(pTHX_ SV **opdata, OP *lhs, OP *rhs,
67             struct Perl_custom_infix *def)
68             {
69             OP *o;
70             PERL_UNUSED_ARG(opdata);
71             PERL_UNUSED_ARG(def);
72 10           o = newBINOP(OP_CUSTOM, 0, lhs, rhs);
73 10           o->op_ppaddr = pp_nei;
74 10           return o;
75             }
76              
77             MODULE = Syntax::Infix::EqualityInsensitive PACKAGE = Syntax::Infix::EqualityInsensitive
78              
79             BOOT:
80 2           XopENTRY_set(&eqi_xop, xop_name, "eqi");
81 2           XopENTRY_set(&eqi_xop, xop_desc, "case-insensitive string equality");
82 2           XopENTRY_set(&eqi_xop, xop_class, OA_BINOP);
83 2           Perl_custom_op_register(aTHX_ pp_eqi, &eqi_xop);
84              
85 2           XopENTRY_set(&nei_xop, xop_name, "nei");
86 2           XopENTRY_set(&nei_xop, xop_desc, "case-insensitive string inequality");
87 2           XopENTRY_set(&nei_xop, xop_class, OA_BINOP);
88 2           Perl_custom_op_register(aTHX_ pp_nei, &nei_xop);
89              
90             IV
91             _eqi_build_op_addr()
92             CODE:
93 1 50         RETVAL = PTR2IV(eqi_build_op);
94             OUTPUT:
95             RETVAL
96              
97             IV
98             _nei_build_op_addr()
99             CODE:
100 1 50         RETVAL = PTR2IV(nei_build_op);
101             OUTPUT:
102             RETVAL