File Coverage

Shuffle.xs
Criterion Covered Total %
statement 36 49 73.4
branch 18 30 60.0
condition n/a
subroutine n/a
pod n/a
total 54 79 68.3


line stmt bran cond sub pod time code
1             #include "EXTERN.h"
2             #include "perl.h"
3             #include "XSUB.h"
4              
5             #include "ppport.h"
6              
7 2000           void shuffle_array(SV **p, IV i) {
8 2000 100         if (i > 0) {
9             do {
10 999000           NV d = Drand01();
11 999000           IV j = (i + 1) * d;
12 999000           SV *tmp = p[i];
13 999000           p[i] = p[j];
14 999000           p[j] = tmp;
15 999000 100         } while (--i);
16             }
17 2000           }
18              
19             void
20 1000           shuffle_huge_array(SV **first, SV **last) {
21             IV i;
22             /* 100_000 is roughly the number of pointers that fit inside a 1MB
23             * processor cache */
24 1000 50         while ((i = last - first) > 100000) {
25 0           SV **f = first, **l = last;
26 0 0         while (f <= l) {
27 0 0         if (Drand01() < 0.5) {
28 0           f++;
29             }
30             else {
31 0           SV *tmp = *f;
32 0           *f = *l;
33 0           *l = tmp;
34 0           l--;
35             }
36             }
37 0           shuffle_huge_array(first, l);
38 0           first = f;
39             }
40 1000           shuffle_array(first, i);
41 1000           }
42              
43             MODULE = Array::Shuffle PACKAGE = Array::Shuffle
44              
45             PROTOTYPES: DISABLE
46              
47             BOOT:
48             #if (PERL_VERSION >= 14)
49 2           sv_setpv((SV*)GvCV(gv_fetchpvs("Array::Shuffle::shuffle_array", 0, SVt_PVCV)), "+");
50 2           sv_setpv((SV*)GvCV(gv_fetchpvs("Array::Shuffle::shuffle_huge_array", 0, SVt_PVCV)), "+");
51             #else
52             sv_setpv((SV*)GvCV(gv_fetchpvs("Array::Shuffle::shuffle_array", 0, SVt_PVCV)), "\\@");
53             sv_setpv((SV*)GvCV(gv_fetchpvs("Array::Shuffle::shuffle_huge_array", 0, SVt_PVCV)), "\\@");
54             #endif
55              
56             void
57             shuffle_array(av)
58             AV *av
59             CODE:
60 1001 50         if (SvREADONLY(av))
61 0           Perl_croak(aTHX_ "can't shuffle a read only array");
62 1001 100         if (SvMAGICAL((SV *)av)) {
63             IV i;
64 10 100         for (i = av_len(av); i > 0; i--) {
65 9           NV d = Drand01();
66 9           IV j = (i + 1) * d;
67 9 100         if (i != j) {
68 5           SV **svpi = av_fetch(av, i, 0);
69 5 50         SV *svi = (svpi ? newSVsv(*svpi) : &PL_sv_undef);
70 5           SV **svpj = av_fetch(av, j, 0);
71 5 50         SV *svj = (svpj ? newSVsv(*svpj) : &PL_sv_undef);
72 5           SV **svj_stored = av_store(av, i, svj);
73 5           mg_set(svj);
74 5 50         if (svj_stored == NULL) SvREFCNT_dec(svj);
75 5           SV **svi_stored = av_store(av, j, svi);
76 5           mg_set(svi);
77 5 50         if (svi_stored == NULL) SvREFCNT_dec(svi);
78             }
79             }
80             }
81             else
82 1000           shuffle_array(AvARRAY(av), av_len(av));
83              
84             void
85             shuffle_huge_array(av)
86             AV *av
87             PREINIT:
88             SV **p;
89             CODE:
90 1000 50         if (SvREADONLY(av))
91 0           Perl_croak(aTHX_ "can't shuffle a read only array");
92 1000 50         if (SvMAGICAL((SV *)av))
93 0           Perl_croak(aTHX_ "shuffle_huge_array can not handle arrays with magic attached");
94 1000           p = AvARRAY(av);
95 1000           shuffle_huge_array(p, p + av_len(av));