File Coverage

MorePerl.xs
Criterion Covered Total %
statement 28 28 100.0
branch 21 36 58.3
condition n/a
subroutine n/a
pod n/a
total 49 64 76.5


line stmt bran cond sub pod time code
1             #include
2             #include
3              
4             using xs::Sv;
5             using xs::merge;
6              
7             typedef OP* (*opcheck_t) (pTHX_ OP* op);
8             static opcheck_t orig_opcheck = NULL;
9              
10 65           static OP* pp_sassign (pTHX) {
11 65           dSP;
12 130           Sv left = *SP;
13 130           Sv right = *(SP-1);
14              
15 65 50         if (PL_op->op_private & OPpASSIGN_BACKWARDS) swap(left, right);
16            
17 65 50         if (left.is_hash_ref() && right.is_hash_ref()) {
    100          
    50          
    50          
    100          
18 3 50         xs::merge(left, right);
    50          
19 3           POPs; SETs(left);
20 3           return NORMAL;
21             }
22            
23 62 50         return PL_ppaddr[PL_op->op_type](aTHX);
24             }
25              
26 65           static OP* opcheck (pTHX_ OP* op) {
27 65 50         OP* ret = orig_opcheck ? orig_opcheck(aTHX_ op) : op;
28 65           const char* packname = SvPVX(PL_curstname);
29 65           STRLEN packlen = SvCUR(PL_curstname);
30 65 50         if (packlen < 2 || packname[0] != 'N' || packname[1] != 'S') return ret;
    50          
    50          
31 65 100         if (packlen > 2 && (packname[2] != ':' || packname[3] != ':')) return ret;
    50          
    50          
32 65           ret->op_ppaddr = pp_sassign;
33 65           return ret;
34             }
35              
36 13           static void enable_op_tracking (pTHX) {
37 13 50         if (PL_check[OP_SASSIGN] == opcheck) return;
38 13           orig_opcheck = PL_check[OP_SASSIGN];
39 13           PL_check[OP_SASSIGN] = opcheck;
40             }
41              
42 13           static void disable_op_tracking (pTHX) {
43 13 50         if (PL_check[OP_SASSIGN] != opcheck) return;
44 13           PL_check[OP_SASSIGN] = orig_opcheck;
45 13           orig_opcheck = NULL;
46             }
47              
48             MODULE = Config::MorePerl PACKAGE = Config::MorePerl
49             PROTOTYPES: DISABLE
50              
51             void enable_op_tracking () {
52 13           enable_op_tracking(aTHX);
53             }
54              
55             void disable_op_tracking () {
56 13           disable_op_tracking(aTHX);
57             }