File Coverage

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