File Coverage

lib/List/Flatten/XS.xs
Criterion Covered Total %
statement 51 52 98.0
branch 37 40 92.5
condition n/a
subroutine n/a
pod n/a
total 88 92 95.6


line stmt bran cond sub pod time code
1             #ifdef __cplusplus
2             extern "C" {
3             #endif
4              
5             #define PERL_NO_GET_CONTEXT /* we want efficiency */
6             #include
7             #include
8             #include
9              
10             #ifdef __cplusplus
11             } /* extern "C" */
12             #endif
13              
14             #define NEED_newSVpvn_flags
15             #include "ppport.h"
16              
17             #define IS_ARRAYREF(sv) SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVAV && !SvOBJECT(SvRV(sv))
18             #define AV_FETCH_MUST(ary, idx) *av_fetch(ary, idx, FALSE)
19              
20             #define AV_PUSH_INC(dest, val) \
21             av_push(dest, SvREFCNT_inc_NN(val)) \
22              
23             #define AV_UNSHIFT_ARRAYREF(dest, src) \
24             ({ \
25             AV *ary = (AV *)SvRV(src); \
26             IV l = av_len(ary) + 1; \
27             av_unshift(dest, l); \
28             SV *val; \
29             for (IV i = 0; i < l; i++) { \
30             val = AV_FETCH_MUST(ary, i); \
31             av_store(dest, i, SvREFCNT_inc_NN(val)); \
32             } \
33             })
34              
35             static SV *
36 54           _fast_flatten(pTHX_ SV *ref)
37             {
38 27           AV *args = (AV *)SvRV(ref);
39 27           AV *dest = (AV *)sv_2mortal((SV *)newAV());
40              
41 27           IV len = av_len(args) + 1;
42 106 100         for (IV i = 0; i < len; i++)
43 79           AV_PUSH_INC(dest, AV_FETCH_MUST(args, i));
44              
45 27           AV *result = (AV *)sv_2mortal((SV *)newAV());
46              
47             // This is to detect circular reference
48 27           HV *memo = (HV *)sv_2mortal((SV *)newHV());
49              
50 619 100         while (av_len(dest) + 1) {
51 597           SV *tmp = av_shift(dest);
52 597 100         if (hv_exists_ent(memo, tmp, 0)) {
53 5           Perl_croak(aTHX_ "tried to flatten recursive list(circular references)");
54             }
55 592 100         if (IS_ARRAYREF(tmp)) {
    100          
56             // store the pointer of array reference
57 214           hv_store_ent(memo, tmp, &PL_sv_undef, 0);
58 753 100         AV_UNSHIFT_ARRAYREF(dest, tmp);
59             } else {
60 592           AV_PUSH_INC(result, tmp);
61             }
62             }
63              
64 22           return sv_2mortal(newRV_inc((SV *)result));
65             }
66              
67             static SV *
68 71           _flatten_per_level(pTHX_ SV *ref, IV level)
69             {
70 71           AV *stack = (AV *)sv_2mortal((SV *)newAV());
71 71           AV *result = (AV *)sv_2mortal((SV *)newAV());
72              
73             // This is to detect circular reference
74 71           HV *memo = (HV *)sv_2mortal((SV *)newHV());
75              
76             IV i = 0;
77             SV *tmp;
78 71           AV *ary = (AV *)SvRV(ref);
79             while (1) {
80 1485 100         while (i < av_len(ary) + 1) {
81 1072           tmp = AV_FETCH_MUST(ary, i++);
82 1072 100         if ((av_len(stack) + 1) / 2 >= level) {
83 218           AV_PUSH_INC(result, tmp);
84 218           continue;
85             }
86              
87 854 100         if (IS_ARRAYREF(tmp)) {
    100          
88 377 100         if (hv_exists_ent(memo, tmp, 0)) {
89             SvREFCNT_inc(stack);
90 5           Perl_croak(aTHX_ "tried to flatten recursive list(circular references)");
91             }
92             // store the pointer of array reference
93 372           hv_store_ent(memo, tmp, &PL_sv_undef, 0);
94              
95             // push value to the stack
96 372           av_push(stack, (SV *)ary);
97 372           av_push(stack, sv_2mortal(newSViv(i)));
98 372           ary = (AV *)SvRV(tmp);
99             i = 0;
100             } else {
101 1414           AV_PUSH_INC(result, tmp);
102             }
103             }
104              
105 413 100         if (av_len(stack) + 1 == 0) break;
106            
107 347           SV *idx = av_pop(stack);
108 347 50         i = SvIV(idx);
109 347           SV *poped = av_pop(stack);
110             ary = (AV *)poped; // Already done SvRV(SV *)
111             }
112              
113 66           return sv_2mortal(newRV_inc((SV *)result));
114             }
115              
116             MODULE = List::Flatten::XS PACKAGE = List::Flatten::XS
117             PROTOTYPES: DISABLE
118              
119             void *
120             flatten(ref, svlevel = sv_2mortal(newSViv(-1)))
121             SV *ref;
122             SV *svlevel;
123             PPCODE:
124             {
125 98 50         if (!SvROK(ref) || SvTYPE(SvRV(ref)) != SVt_PVAV)
    50          
126 0           Perl_croak(aTHX_ "Please pass an array reference to the first argument");
127            
128 98 100         IV level = SvIV(svlevel);
129             SV *result = (level < 0) ? _fast_flatten(aTHX_ ref)
130 98 100         : _flatten_per_level(aTHX_ ref, level);
131              
132 88 100         if (GIMME_V == G_ARRAY) {
    100          
133 42           AV *av_result = (AV *)SvRV(result);
134 42           IV len = av_len(av_result) + 1;
135 459 100         for (IV i = 0; i < len; i++)
136 417           ST(i) = AV_FETCH_MUST(av_result, i);
137 42           XSRETURN(len);
138             }
139              
140 46           ST(0) = result;
141 46           XSRETURN(1);
142             }