File Coverage

Cover.xs
Criterion Covered Total %
statement 394 516 76.3
branch 367 852 43.0
condition n/a
subroutine n/a
pod n/a
total 761 1368 55.6


line stmt bran cond sub pod time code
1             /*
2             * Copyright 2001-2017, Paul Johnson (paul@pjcj.net)
3             *
4             * This software is free. It is licensed under the same terms as Perl itself.
5             *
6             * The latest version of this software should be available from my homepage:
7             * http://www.pjcj.net
8              *
9              */
10            
11             #ifdef __cplusplus
12             extern "C" {
13             #endif
14            
15             #define PERL_NO_GET_CONTEXT
16             #include "EXTERN.h"
17             #include "perl.h"
18             #include "XSUB.h"
19            
20             #ifdef __cplusplus
21             }
22             #endif
23            
24             #ifdef PERL_OBJECT
25             #define CALLOP this->*PL_op
26             #else
27             #define CALLOP *PL_op
28             #endif
29            
30             #ifndef START_MY_CXT
31             /* No threads in 5.6 */
32             #define START_MY_CXT static my_cxt_t my_cxt;
33             #define dMY_CXT_SV dNOOP
34             #define dMY_CXT dNOOP
35             #define MY_CXT_INIT NOOP
36             #define MY_CXT my_cxt
37            
38             #define pMY_CXT void
39             #define pMY_CXT_
40             #define _pMY_CXT
41             #define aMY_CXT
42             #define aMY_CXT_
43             #define _aMY_CXT
44             #endif
45            
46             #define MY_CXT_KEY "Devel::Cover::_guts" XS_VERSION
47            
48             #define PDEB(a) a
49             #define NDEB(a) ;
50             #define D PerlIO_printf
51             #define L Perl_debug_log
52             #define svdump(sv) do_sv_dump(0, L, (SV *)sv, 0, 10, 1, 0);
53            
54             #define None 0x00000000
55             #define Statement 0x00000001
56             #define Branch 0x00000002
57             #define Condition 0x00000004
58             #define Subroutine 0x00000008
59             #define Path 0x00000010
60             #define Pod 0x00000020
61             #define Time 0x00000040
62             #define All 0xffffffff
63            
64             #define CAN_PROFILE defined HAS_GETTIMEOFDAY || defined HAS_TIMES
65            
66             struct unique { /* Well, we'll be fairly unlucky if it's not */
67             OP *addr,
68             op;
69             /* include hashed file location information, where available (cops) */
70             size_t fileinfohash;
71             };
72            
73             #define KEY_SZ sizeof(struct unique)
74            
75             typedef struct {
76             unsigned covering;
77             int collecting_here;
78             HV *cover,
79             *statements,
80             *branches,
81             *conditions,
82             #if CAN_PROFILE
83             *times,
84             #endif
85             *modules,
86             *files;
87             AV *ends;
88             char profiling_key[KEY_SZ];
89             bool profiling_key_valid;
90             SV *module,
91             *lastfile;
92             int tid;
93             int replace_ops;
94             /* - fix up whatever is broken with module_relative on Windows here */
95            
96             #if PERL_VERSION > 8
97             Perl_ppaddr_t ppaddr[MAXO];
98             #else
99             OP *(*ppaddr[MAXO])(pTHX);
100             #endif
101             } my_cxt_t;
102            
103             #ifdef USE_ITHREADS
104             static perl_mutex DC_mutex;
105             #endif
106            
107             static HV *Pending_conditionals,
108             *Return_ops;
109             static int tid;
110            
111             START_MY_CXT
112            
113             #define collecting(criterion) (MY_CXT.covering & (criterion))
114            
115             #ifdef HAS_GETTIMEOFDAY
116            
117             #ifdef __cplusplus
118             extern "C" {
119             #endif
120            
121             #ifdef WIN32
122             #include <time.h>
123             #else
124             #include <sys/time.h>
125             #endif
126              
127             #ifdef __cplusplus
128             }
129             #endif
130              
131             /* op->op_sibling is deprecated on new perls, but the OpSIBLING macro doesn't
132                exist on older perls. We don't need to check for PERL_OP_PARENT here
133                because if PERL_OP_PARENT was set, and we needed to check op_moresib,
134                we would already have this macro. */
135             #ifndef OpSIBLING
136             #define OpSIBLING(o) (0 + (o)->op_sibling)
137             #endif
138            
139 26033           static double get_elapsed() {
140             #ifdef WIN32
141             dTHX;
142             #endif
143             struct timeval time;
144             double e;
145            
146 26033           gettimeofday(&time, NULL);
147 26033           e = time.tv_sec * 1e6 + time.tv_usec;
148            
149 26033           return e;
150             }
151            
152 25877           static double elapsed() {
153             static double p;
154             double e, t;
155            
156 25877           t = get_elapsed();
157 25877           e = t - p;
158 25877           p = t;
159            
160 25877           return e;
161             }
162            
163             #elif defined HAS_TIMES
164            
165             #ifndef HZ
166             # ifdef CLK_TCK
167             # define HZ CLK_TCK
168             # else
169             # define HZ 60
170             # endif
171             #endif
172            
173             static int cpu() {
174             #ifdef WIN32
175             dTHX;
176             #endif
177             static struct tms time;
178             static int utime = 0,
179             stime = 0;
180             int e;
181            
182             #ifndef VMS
183             (void)PerlProc_times(&time);
184             #else
185             (void)PerlProc_times((tbuffer_t *)&time);
186             #endif
187            
188             e = time.tms_utime - utime + time.tms_stime - stime;
189             utime = time.tms_utime;
190             stime = time.tms_stime;
191            
192             return e / HZ;
193             }
194              
195             #endif /* HAS_GETTIMEOFDAY */
196              
197             /*
198              * http://codereview.stackexchange.com/questions/85556/simple-string-hashing-algorithm-implementation
199              * https://en.wikipedia.org/wiki/Fowler%E2%80%93Noll%E2%80%93Vo_hash_function
200              * http://www.isthe.com/chongo/tech/comp/fnv/index.html#public_domain
201              *
202              * FNV hash algorithms and source code have been released into the
203              * public domain. The authors of the FNV algorithmm took deliberate
204              * steps to disclose the algorhtm in a public forum soon after it was
205              * invented. More than a year passed after this public disclosure and the
206              * authors deliberatly took no steps to patent the FNV algorithm. Therefore
207              * it is safe to say that the FNV authors have no patent claims on the FNV
208              * algorithm as published.
209              *
210             */
211            
212             /* Fowler/Noll/Vo (FNV) hash function, variant 1a */
213 651261           static size_t fnv1a_hash(const char* cp)
214             {
215 651261           size_t hash = 0x811c9dc5;
216 33337259 100         while (*cp) {
217 32685998           hash ^= (unsigned char) *cp++;
218 32685998           hash *= 0x01000193;
219             }
220 651261           return hash;
221             }
222            
223             #define FILEINFOSZ 1024
224            
225 1042608           static char *get_key(OP *o) {
226             static struct unique uniq;
227             static char mybuf[FILEINFOSZ];
228            
229 1042608           uniq.addr = o;
230 1042608           uniq.op = *o;
231 1042608           uniq.op.op_ppaddr = 0; /* we mess with this field */
232 1042608           uniq.op.op_targ = 0; /* might change */
233 1693869 100         if (o->op_type == OP_NEXTSTATE || o->op_type == OP_DBSTATE) {
    50          
234             /* cop, has file location information */
235 651261 50         char *file = CopFILE((COP *)o);
236 651261           long line = CopLINE((COP *)o);
237 651261           snprintf(mybuf, FILEINFOSZ - 1, "%s:%ld", file, line);
238 651261           uniq.fileinfohash = fnv1a_hash(mybuf);
239             } else {
240             /* no file location information available */
241 391347           uniq.fileinfohash = 0;
242             }
243            
244 1042608           return (char *)&uniq;
245             }
246            
247 0           static char *hex_key(char *key) {
248             static char hk[KEY_SZ * 2 + 1];
249             unsigned int c;
250 0 0         for (c = 0; c < KEY_SZ; c++) {
251             NDEB(D(L, "%d of %d, <%02X> at %p\n",
252             c, KEY_SZ, (unsigned char)key[c], hk + c * 2));
253 0           sprintf(hk + c * 2, "%02X", (unsigned char)key[c]);
254             }
255 0           hk[c * 2] = 0;
256 0           return hk;
257             }
258            
259 1828           static void set_firsts_if_needed(pTHX) {
260 1828           SV *init = (SV *)get_cv("Devel::Cover::first_init", 0);
261 1828           SV *end = (SV *)get_cv("Devel::Cover::first_end", 0);
262             NDEB(svdump(end));
263 1828 50         if (PL_initav && av_len(PL_initav) >= 0)
    100          
264             {
265 1668           SV **cv = av_fetch(PL_initav, 0, 0);
266 1668 100         if (*cv != init) {
267 78           av_unshift(PL_initav, 1);
268 78           av_store(PL_initav, 0, init);
269             }
270             }
271 1828 50         if (PL_endav && av_len(PL_endav) >= 0) {
    50          
272 1828           SV **cv = av_fetch(PL_endav, 0, 0);
273 1828 100         if (*cv != end) {
274 229           av_unshift(PL_endav, 1);
275 229           av_store(PL_endav, 0, end);
276             }
277             }
278 1828           }
279            
280 521923           static int check_if_collecting(pTHX_ COP *cop) {
281             dMY_CXT;
282            
283             #if !NO_TAINT_SUPPORT
284 521923           int tainted = PL_tainted;
285             #endif
286 521923 50         char *file = CopFILE(cop);
287 521923           int in_re_eval = strnEQ(file, "(reeval ", 8);
288             NDEB(D(L, "check_if_collecting at: %s:%ld\n", file, CopLINE(cop)));
289 521923 50         if (file && strNE(SvPV_nolen(MY_CXT.lastfile), file)) {
    50          
    100          
290 41573           int found = 0;
291 41573 50         if (MY_CXT.files) {
292 41573           SV **f = hv_fetch(MY_CXT.files, file, strlen(file), 0);
293 41573 100         if (f) {
294 36562 50         MY_CXT.collecting_here = SvIV(*f);
295 36562           found = 1;
296             NDEB(D(L, "File: %s:%ld [%d]\n",
297             file, CopLINE(cop), MY_CXT.collecting_here));
298             }
299             }
300            
301 41573 100         if (!found && MY_CXT.replace_ops && !in_re_eval) {
    50          
    50          
302 5011           dSP;
303             int count;
304             SV *rv;
305            
306 5011           ENTER;
307 5011           SAVETMPS;
308            
309 5011 50         PUSHMARK(SP);
310 5011 50         XPUSHs(sv_2mortal(newSVpv(file, 0)));
311 5011           PUTBACK;
312            
313 5011           count = call_pv("Devel::Cover::use_file", G_SCALAR);
314            
315 5011           SPAGAIN;
316            
317 5011 50         if (count != 1)
318 0           croak("use_file returned %d values\n", count);
319            
320 5011           rv = POPs;
321 5011 50         MY_CXT.collecting_here = SvTRUE(rv) ? 1 : 0;
    50          
    0          
    50          
    0          
    0          
    50          
    0          
    0          
    0          
    0          
    0          
    50          
    50          
    100          
    50          
    0          
    100          
    0          
322            
323             NDEB(D(L, "-- %s - %d\n", file, MY_CXT.collecting_here));
324            
325 5011           PUTBACK;
326 5011 50         FREETMPS;
327 5011           LEAVE;
328             }
329            
330 41573           sv_setpv(MY_CXT.lastfile, file);
331             }
332             NDEB(D(L, "%s - %d\n",
333             SvPV_nolen(MY_CXT.lastfile), MY_CXT.collecting_here));
334            
335             #if PERL_VERSION > 6
336 521923 50         if (SvTRUE(MY_CXT.module)) {
    50          
    50          
    0          
    0          
    50          
    50          
    100          
    50          
    0          
    0          
    0          
    0          
    0          
    0          
    100          
337             STRLEN mlen,
338 1750           flen = strlen(file);
339 1750 50         char *m = SvPV(MY_CXT.module, mlen);
340 1750 50         if (flen >= mlen && strnEQ(m, file + flen - mlen, mlen)) {
    100          
341 388           SV **dir = hv_fetch(MY_CXT.modules, file, strlen(file), 1);
342 388 100         if (!SvROK(*dir)) {
343 387           SV *cwd = newSV(0);
344 387           AV *d = newAV();
345 387           *dir = newRV_inc((SV*) d);
346 387           av_push(d, newSVsv(MY_CXT.module));
347 387 50         if (getcwd_sv(cwd)) {
348 387           av_push(d, newSVsv(cwd));
349             NDEB(D(L, "require %s as %s from %s\n",
350             m, file, SvPV_nolen(cwd)));
351             }
352             }
353             }
354 1750           sv_setpv(MY_CXT.module, "");
355 1750           set_firsts_if_needed(aTHX);
356             }
357             #endif
358            
359             #if !NO_TAINT_SUPPORT
360 521923           PL_tainted = tainted;
361             #endif
362 521923           return MY_CXT.collecting_here;
363             }
364            
365             #if CAN_PROFILE
366            
367 512799           static void cover_time(pTHX)
368             {
369             dMY_CXT;
370             SV **count;
371             NV c;
372            
373 512799 100         if (collecting(Time)) {
374             /*
375                      * Profiling information is stored against MY_CXT.profiling_key,
376                      * the key for the op we have just run
377                      */
378            
379             NDEB(D(L, "Cop at %p, op at %p\n", PL_curcop, PL_op));
380            
381 507107 100         if (MY_CXT.profiling_key_valid) {
382 25799           count = hv_fetch(MY_CXT.times, MY_CXT.profiling_key, KEY_SZ, 1);
383 25799 50         c = (SvTRUE(*count) ? SvNV(*count) : 0) +
    50          
    0          
    100          
    50          
    50          
    50          
    0          
    0          
    0          
    0          
    0          
    50          
    50          
    0          
    50          
    50          
    50          
    0          
    50          
384             #if defined HAS_GETTIMEOFDAY
385 25799           elapsed();
386             #else
387             cpu();
388             #endif
389 25799           sv_setnv(*count, c);
390             }
391 507107 50         if (PL_op) {
392 507107           memcpy(MY_CXT.profiling_key, get_key(PL_op), KEY_SZ);
393 507107           MY_CXT.profiling_key_valid = 1;
394             } else {
395 0           MY_CXT.profiling_key_valid = 0;
396             }
397             }
398 512799           }
399            
400             #endif
401            
402 529332           static int collecting_here(pTHX) {
403             dMY_CXT;
404            
405 529332 100         if (MY_CXT.collecting_here) return 1;
406            
407             #if CAN_PROFILE
408 482713           cover_time(aTHX);
409 482713           MY_CXT.profiling_key_valid = 0;
410             #endif
411            
412             NDEB(D(L, "op %p is %s\n", PL_op, OP_NAME(PL_op)));
413 482713 50         if (hv_exists(Return_ops, get_key(PL_op), KEY_SZ))
414 0           return MY_CXT.collecting_here = 1;
415             else
416 482713           return 0;
417             }
418            
419 83846           static void store_return(pTHX) {
420             dMY_CXT;
421            
422             /*
423                  * If we are jumping somewhere we might not be collecting
424                  * coverage there, so store where we will be coming back to
425                  * so we can turn on coverage straight away. We need to
426                  * store more than one return op because a non collecting
427                  * sub may call back to a collecting sub.
428                  */
429            
430 83846 100         if (MY_CXT.collecting_here && PL_op->op_next) {
    100          
431 3991           (void)hv_fetch(Return_ops, get_key(PL_op->op_next), KEY_SZ, 1);
432             NDEB(D(L, "adding return op %p\n", PL_op->op_next));
433             }
434 83846           }
435            
436 1750           static void store_module(pTHX) {
437             dMY_CXT;
438 1750           dSP;
439            
440             #if PERL_VERSION > 8
441 1750 100         SvSetSV_nosteal(MY_CXT.module, (SV*)newSVpv(SvPV_nolen(TOPs), 0));
    50          
    100          
442             NDEB(D(L, "require %s\n", SvPV_nolen(MY_CXT.module)));
443             #endif
444 1750           }
445            
446 0           static void call_report(pTHX) {
447 0           dSP;
448 0 0         PUSHMARK(SP);
449 0           call_pv("Devel::Cover::report", G_VOID|G_DISCARD|G_EVAL);
450 0           SPAGAIN;
451 0           }
452            
453 30135           static void cover_statement(pTHX_ OP *op) {
454             dMY_CXT;
455            
456             char *ch;
457             SV **count;
458             IV c;
459            
460 30135 100         if (!collecting(Statement)) return;
461            
462 25848           ch = get_key(op);
463 25848           count = hv_fetch(MY_CXT.statements, ch, KEY_SZ, 1);
464 25848 50         c = SvTRUE(*count) ? SvIV(*count) + 1 : 1;
    50          
    0          
    100          
    50          
    50          
    50          
    0          
    0          
    0          
    0          
    0          
    50          
    50          
    50          
    0          
    0          
    50          
    0          
    50          
465            
466             NDEB(D(L, "Statement: %s:%ld\n", CopFILE(cCOPx(op)), CopLINE(cCOPx(op))));
467            
468 25848           sv_setiv(*count, c);
469             NDEB(op_dump(op));
470             }
471            
472 30086           static void cover_current_statement(pTHX) {
473             #if CAN_PROFILE
474 30086           cover_time(aTHX);
475             #endif
476            
477 30086           cover_statement(aTHX_ PL_op);
478 30086           }
479            
480 6409           static void add_branch(pTHX_ OP *op, int br) {
481             dMY_CXT;
482            
483             AV *branches;
484             SV **count;
485             int c;
486 6409           SV **tmp = hv_fetch(MY_CXT.branches, get_key(op), KEY_SZ, 1);
487            
488 6409 100         if (SvROK(*tmp)) {
489 6006           branches = (AV *) SvRV(*tmp);
490             } else {
491 403           *tmp = newRV_inc((SV*) (branches = newAV()));
492 403           av_unshift(branches, 2);
493             }
494            
495 6409           count = av_fetch(branches, br, 1);
496 6409 50         c = SvTRUE(*count) ? SvIV(*count) + 1 : 1;
    50          
    0          
    100          
    50          
    50          
    50          
    0          
    0          
    0          
    0          
    0          
    50          
    50          
    50          
    0          
    0          
    50          
    0          
    50          
497 6409           sv_setiv(*count, c);
498             NDEB(D(L, "Adding branch making %d at %p\n", c, op));
499 6409           }
500            
501 15160           static AV *get_conditional_array(pTHX_ OP *op) {
502             dMY_CXT;
503            
504             AV *conds;
505 15160           SV **cref = hv_fetch(MY_CXT.conditions, get_key(op), KEY_SZ, 1);
506            
507 15160 100         if (SvROK(*cref))
508 12306           conds = (AV *) SvRV(*cref);
509             else
510 2854           *cref = newRV_inc((SV*) (conds = newAV()));
511            
512 15160           return conds;
513             }
514            
515 7257           static void set_conditional(pTHX_ OP *op, int cond, int value) {
516             /*
517                  * The conditional array comprises six elements:
518                  *
519                  * 0 - 1 iff we are in an xor and the first operand was true
520                  * 1 - not short circuited - second operand is false
521                  * 2 - not short circuited - second operand is true
522                  * 3 - short circuited, or for xor second operand is false
523                  * 4 - for xor second operand is true
524                  * 5 - 1 iff we are in void context
525                  */
526            
527 7257           SV **count = av_fetch(get_conditional_array(aTHX_ op), cond, 1);
528 7257           sv_setiv(*count, value);
529             NDEB(D(L, "Setting %d conditional to %d at %p\n", cond, value, op));
530 7257           }
531            
532 7401           static void add_conditional(pTHX_ OP *op, int cond) {
533 7401           SV **count = av_fetch(get_conditional_array(aTHX_ op), cond, 1);
534 7401 50         int c = SvTRUE(*count) ? SvIV(*count) + 1 : 1;
    50          
    0          
    100          
    50          
    50          
    50          
    0          
    0          
    0          
    0          
    0          
    50          
    50          
    50          
    0          
    0          
    50          
    0          
    50          
535 7401           sv_setiv(*count, c);
536             NDEB(D(L, "Adding %d conditional making %d at %p\n", cond, c, op));
537 7401           }
538            
539             #ifdef USE_ITHREADS
540             static AV *get_conds(pTHX_ AV *conds) {
541             dMY_CXT;
542            
543             AV *thrconds;
544             HV *threads;
545             SV *tid,
546             **cref;
547             char *t;
548            
549             if (av_exists(conds, 2)) {
550             SV **cref = av_fetch(conds, 2, 0);
551             threads = (HV *) *cref;
552             } else {
553             threads = newHV();
554             HvSHAREKEYS_off(threads);
555             av_store(conds, 2, (SV *)threads);
556             }
557            
558             tid = newSViv(MY_CXT.tid);
559            
560             t = SvPV_nolen(tid);
561             cref = hv_fetch(threads, t, strlen(t), 1);
562            
563             if (SvROK(*cref))
564             thrconds = (AV *)SvRV(*cref);
565             else
566             *cref = newRV_inc((SV*) (thrconds = newAV()));
567            
568             return thrconds;
569             }
570             #endif
571            
572 1004           static void add_condition(pTHX_ SV *cond_ref, int value) {
573 1004           int final = !value;
574 1004           AV *conds = (AV *) SvRV(cond_ref);
575 1004 50         OP *next = INT2PTR(OP *, SvIV(*av_fetch(conds, 0, 0)));
576 1004 50         OP *(*addr)(pTHX) = INT2PTR(OP *(*)(pTHX), SvIV(*av_fetch(conds, 1, 0)));
577             I32 i;
578            
579 1004 100         if (!final && next != PL_op)
    50          
580 0           croak("next (%p) does not match PL_op (%p)", next, PL_op);
581            
582             #ifdef USE_ITHREADS
583             i = 0;
584             conds = get_conds(aTHX_ conds);
585             #else
586 1004           i = 2;
587             #endif
588             NDEB(D(L, "Looking through %d conditionals at %p\n",
589             av_len(conds) - 1, PL_op));
590 1506 100         for (; i <= av_len(conds); i++) {
591 502 50         OP *op = INT2PTR(OP *, SvIV(*av_fetch(conds, i, 0)));
592 502           SV **count = av_fetch(get_conditional_array(aTHX_ op), 0, 1);
593 502 50         int type = SvTRUE(*count) ? SvIV(*count) : 0;
    50          
    0          
    50          
    50          
    50          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
594 502           sv_setiv(*count, 0);
595            
596             /* Check if we have come from an xor with a true first op */
597 502 50         if (final) value = 1;
598 502 50         if (type == 1) value += 2;
599            
600             NDEB(D(L, "Found %p: %d, %d\n", op, type, value));
601 502           add_conditional(aTHX_ op, value);
602             }
603            
604             #ifdef USE_ITHREADS
605             i = -1;
606             #else
607 1004           i = 1;
608             #endif
609 1506 100         while (av_len(conds) > i) av_pop(conds);
610            
611             NDEB(svdump(conds));
612             NDEB(D(L, "addr is %p, next is %p, PL_op is %p, length is %d final is %d\n",
613             addr, next, PL_op, av_len(conds), final));
614 1004 100         if (!final) next->op_ppaddr = addr;
615 1004           }
616            
617 0           static void dump_conditions(pTHX) {
618             HE *e;
619            
620             MUTEX_LOCK(&DC_mutex);
621 0           hv_iterinit(Pending_conditionals);
622 0           PDEB(D(L, "Pending_conditionals:\n"));
623            
624 0 0         while ((e = hv_iternext(Pending_conditionals))) {
625             I32 len;
626 0           char *key = hv_iterkey(e, &len);
627 0           SV *cond_ref = hv_iterval(Pending_conditionals, e);
628 0           AV *conds = (AV *) SvRV(cond_ref);
629 0 0         OP *next = INT2PTR(OP *, SvIV(*av_fetch(conds, 0,0)));
630 0 0         OP *(*addr)(pTHX) = INT2PTR(OP *(*)(pTHX), SvIV(*av_fetch(conds, 1,0)));
631             I32 i;
632            
633             #ifdef USE_ITHREADS
634             i = 0; /* TODO - this can't be right */
635             conds = get_conds(aTHX_ conds);
636             #else
637 0           i = 2;
638             #endif
639            
640 0           PDEB(D(L, " %s: op %p, next %p (%ld)\n",
641             hex_key(key), next, addr, (long)av_len(conds) - 1));
642            
643 0 0         for (; i <= av_len(conds); i++) {
644 0 0         OP *op = INT2PTR(OP *, SvIV(*av_fetch(conds, i, 0)));
645 0           SV **count = av_fetch(get_conditional_array(aTHX_ op), 0, 1);
646 0 0         int type = SvTRUE(*count) ? SvIV(*count) : 0;
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
647 0           sv_setiv(*count, 0);
648            
649 0           PDEB(D(L, " %2d: %p, %d\n", i - 2, op, type));
650             }
651             }
652             MUTEX_UNLOCK(&DC_mutex);
653 0           }
654            
655             #if PERL_VERSION > 18
656             /* For if ($a || $b) and unless ($a && $b), rpeep skips past a few
657              * logops and messes with Devel::Cover
658              *
659              * This function will find the skipped op if there is one
660              */
661 4303           static OP *find_skipped_conditional(pTHX_ OP *o) {
662             OP *right,
663             *next;
664            
665 4303 100         if (o->op_type != OP_OR && o->op_type != OP_AND)
    100          
666 9           return NULL;
667            
668             /* Get to the end of the "a || b || c" block */
669 4294 50         right = OpSIBLING(cLOGOP->op_first);
670 4294 50         while (right && OpSIBLING(cLOGOPx(right)))
    50          
    0          
671 0 0         right = OpSIBLING(cLOGOPx(right));
672            
673 4294 50         if (!right)
674 0           return NULL;
675            
676 4294           next = right->op_next;
677 4433 50         while (next && next->op_type == OP_NULL)
    100          
678 139           next = next->op_next;
679            
680 4294 50         if (!next)
681 0           return NULL;
682            
683 4294 50         if (o == next)
684 0           return NULL;
685            
686 4294 50         if (next->op_type != OP_OR && next->op_type != OP_AND)
    100          
687 4150           return NULL;
688            
689             /* if ($a || $b) or unless ($a && $b) */
690 144 50         if (o->op_type == next->op_type)
691 144           return NULL;
692            
693 0 0         if ((next->op_flags & OPf_WANT) != OPf_WANT_VOID)
694 0           return NULL;
695            
696 0 0         if (!cLOGOPx(next)->op_other || !o->op_next)
    0          
697 0           return NULL;
698            
699 0 0         if (cLOGOPx(next)->op_other != o->op_next)
700 0           return NULL;
701            
702 0           return next;
703             }
704             #endif
705            
706             /* NOTE: caller must protect get_condition calls by locking DC_mutex */
707            
708 502           static OP *get_condition(pTHX) {
709 502           SV **pc = hv_fetch(Pending_conditionals, get_key(PL_op), KEY_SZ, 0);
710            
711 1004 50         if (pc && SvROK(*pc)) {
    50          
712 502           dSP;
713             NDEB(D(L, "get_condition from %p, %p: %p (%s)\n",
714             PL_op, (void *)PL_op->op_targ, pc, hex_key(get_key(PL_op))));
715             /* dump_conditions(aTHX); */
716             NDEB(svdump(Pending_conditionals));
717 502 50         add_condition(aTHX_ *pc, SvTRUE(TOPs) ? 2 : 1);
    50          
    0          
    50          
    0          
    0          
    100          
    50          
    100          
    100          
    50          
    100          
    100          
    50          
    50          
    50          
    0          
    50          
    50          
718             } else {
719 0           PDEB(D(L, "All is lost, I know not where to go from %p, %p: %p (%s)\n",
720             PL_op, (void *)PL_op->op_targ, pc, hex_key(get_key(PL_op))));
721 0           dump_conditions(aTHX);
722             NDEB(svdump(Pending_conditionals));
723             /* croak("urgh"); */
724 0           exit(1);
725             }
726            
727 502           return PL_op;
728             }
729            
730 78           static void finalise_conditions(pTHX) {
731             /*
732                  * Our algorithm for conditions relies on ending up at a particular
733                  * op which we use to call get_condition(). It's possible that we
734                  * never get to that op; for example we might return out of a sub.
735                  * This causes us to lose coverage information.
736                  *
737                  * This function is called after the program has been run in order
738                  * to collect that lost information.
739                  */
740            
741             HE *e;
742            
743             NDEB(D(L, "finalise_conditions\n"));
744             /* dump_conditions(aTHX); */
745             NDEB(svdump(Pending_conditionals));
746            
747             MUTEX_LOCK(&DC_mutex);
748 78           hv_iterinit(Pending_conditionals);
749            
750 580 100         while ((e = hv_iternext(Pending_conditionals)))
751 502           add_condition(aTHX_ hv_iterval(Pending_conditionals, e), 0);
752             MUTEX_UNLOCK(&DC_mutex);
753 78           }
754            
755 6409           static void cover_cond(pTHX)
756             {
757             dMY_CXT;
758 6409 50         if (collecting(Branch)) {
759 6409           dSP;
760 6409 50         int val = SvTRUE(TOPs);
    50          
    0          
    100          
    50          
    50          
    100          
    50          
    100          
    100          
    50          
    100          
    50          
    0          
    0          
    0          
    0          
    0          
    50          
761 6409           add_branch(aTHX_ PL_op, !val);
762             }
763 6409           }
764            
765 8374           static void cover_logop(pTHX) {
766             /*
767                  * For OP_AND, if the first operand is false, we have short
768                  * circuited the second, otherwise the value of the and op is the
769                  * value of the second operand.
770                  *
771                  * For OP_OR, if the first operand is true, we have short circuited
772                  * the second, otherwise the value of the and op is the value of the
773                  * second operand.
774                  *
775                  * We check the value of the first operand by simply looking on the
776                  * stack. To check the second operand it is necessary to note the
777                  * location of the next op after this logop. When we get there, we
778                  * look at the stack and store the coverage information indexed to
779                  * this op.
780                  *
781                  * This scheme also works for OP_XOR with a small modification
782                  * because it doesn't short circuit. See the comment below.
783                  *
784                  * To find out when we get to the next op we change the op_ppaddr to
785                  * point to get_condition(), which will do the necessary work and
786                  * then reset and run the original op_ppaddr. We also store
787                  * information in the Pending_conditionals hash. This is keyed on
788                  * the op and the value is an array, the first element of which is
789                  * the op we are messing with, the second element of which is the
790                  * op_ppaddr we overwrote, and the subsequent elements are the ops
791                  * about which we are collecting the condition coverage information.
792                  * Note that an op may be collecting condition coverage information
793                  * about a number of conditions.
794                  */
795            
796             dMY_CXT;
797            
798             NDEB(D(L, "logop() at %p\n", PL_op));
799             NDEB(op_dump(PL_op));
800            
801 8374 50         if (!collecting(Condition))
802 0           return;
803            
804 8374 100         if (cLOGOP->op_first->op_type == OP_ITER) {
805             /* loop - ignore it for now*/
806             } else {
807 7257           dSP;
808            
809 7257 50         int left_val = SvTRUE(TOPs);
    50          
    0          
    100          
    50          
    50          
    100          
    50          
    100          
    100          
    50          
    100          
    50          
    50          
    100          
    50          
    0          
    100          
    0          
810             #if PERL_VERSION > 8
811 7257 100         int left_val_def = SvOK(TOPs);
    50          
    50          
812             #endif
813             /* We don't count X= as void context because we care about the value
814                      * of the RHS */
815 6821 100         int void_context = GIMME_V == G_VOID &&
    100          
816             #if PERL_VERSION > 8
817 6741 50         PL_op->op_type != OP_DORASSIGN &&
818             #endif
819 14078 100         PL_op->op_type != OP_ANDASSIGN &&
    100          
    100          
820 6741           PL_op->op_type != OP_ORASSIGN;
821             NDEB(D(L, "left_val: %d, void_context: %d at %p\n",
822             left_val, void_context, PL_op));
823             NDEB(op_dump(PL_op));
824            
825 7257           set_conditional(aTHX_ PL_op, 5, void_context);
826            
827 7257 100         if ((PL_op->op_type == OP_AND && left_val) ||
    100          
    50          
828 4946 0         (PL_op->op_type == OP_ANDASSIGN && left_val) ||
    100          
829 4946 100         (PL_op->op_type == OP_OR && !left_val) ||
    100          
830 4518 100         (PL_op->op_type == OP_ORASSIGN && !left_val) ||
    50          
831             #if PERL_VERSION > 8
832 4303 0         (PL_op->op_type == OP_DOR && !left_val_def) ||
    100          
833 4303 50         (PL_op->op_type == OP_DORASSIGN && !left_val_def) ||
    50          
834             #endif
835 2954           (PL_op->op_type == OP_XOR)) {
836             /* no short circuit */
837            
838 2954 50         OP *right = OpSIBLING(cLOGOP->op_first);
839            
840             NDEB(op_dump(right));
841            
842 2954 100         if (void_context ||
    50          
843 502 50         right->op_type == OP_NEXT ||
844 502 50         right->op_type == OP_LAST ||
845 502 50         right->op_type == OP_REDO ||
846 502 50         right->op_type == OP_GOTO ||
847 502 50         right->op_type == OP_RETURN ||
848 502           right->op_type == OP_DIE) {
849             /*
850                              * If we are in void context, or the right side of the op is a
851                              * branch, we don't care what its value is - it won't be
852                              * returning one. We're just glad to be here, so we chalk up
853                              * success.
854                              */
855            
856             NDEB(D(L, "Add conditional 2\n"));
857 2452           add_conditional(aTHX_ PL_op, 2);
858             } else {
859             char *ch;
860             AV *conds;
861             SV **cref,
862             *cond;
863             OP *next;
864            
865 502 50         if (PL_op->op_type == OP_XOR && left_val) {
    0          
866             /*
867                                  * This is an xor. It does not short circuit. We
868                                  * have just executed the first op. When we get to
869                                  * next we will have already done the xor, so we can
870                                  * work out what the value of the second op was.
871                                  *
872                                  * We set a flag in the first element of the array
873                                  * to say that we had a true value from the first
874                                  * op.
875                                  */
876            
877 0           set_conditional(aTHX_ PL_op, 0, 1);
878             }
879            
880             #if PERL_VERSION > 14
881             NDEB(D(L, "Getting next\n"));
882 1004           next = (PL_op->op_type == OP_XOR)
883 0           ? PL_op->op_next
884 502 50         : right->op_next;
885 564 50         while (next && next->op_type == OP_NULL)
    100          
886 62           next = next->op_next;
887             #else
888             next = PL_op->op_next;
889             #endif
890 502 50         if (!next) return; /* in fold_constants */
891             NDEB(op_dump(PL_op));
892             NDEB(op_dump(next));
893            
894 502           ch = get_key(next);
895             MUTEX_LOCK(&DC_mutex);
896 502           cref = hv_fetch(Pending_conditionals, ch, KEY_SZ, 1);
897            
898 502 50         if (SvROK(*cref))
899 0           conds = (AV *)SvRV(*cref);
900             else
901 502           *cref = newRV_inc((SV*) (conds = newAV()));
902            
903 502 50         if (av_len(conds) < 0) {
904 502           av_push(conds, newSViv(PTR2IV(next)));
905 502           av_push(conds, newSViv(PTR2IV(next->op_ppaddr)));
906             }
907            
908             #ifdef USE_ITHREADS
909             conds = get_conds(aTHX_ conds);
910             #endif
911            
912 502           cond = newSViv(PTR2IV(PL_op));
913 502           av_push(conds, cond);
914            
915             NDEB(D(L, "Adding conditional %p (%s) "
916             "making %d at %p (%s), ppaddr: %p\n",
917             next, PL_op_name[next->op_targ], av_len(conds) - 1,
918             PL_op, hex_key(ch), next->op_ppaddr));
919             /* dump_conditions(aTHX); */
920             NDEB(svdump(Pending_conditionals));
921             NDEB(op_dump(PL_op));
922             NDEB(op_dump(next));
923            
924 502           next->op_ppaddr = get_condition;
925             MUTEX_UNLOCK(&DC_mutex);
926             }
927             } else {
928             /* short circuit */
929             #if PERL_VERSION > 14
930 4303 50         OP *up = OpSIBLING(cLOGOP->op_first)->op_next;
931             #if PERL_VERSION > 18
932             OP *skipped;
933             #endif
934            
935 4303 50         while (up && up->op_type == PL_op->op_type) {
    100          
936             NDEB(D(L, "Considering adding %p (%s) -> (%p) "
937             "from %p (%s) -> (%p)\n",
938             up, PL_op_name[up->op_type], up->op_next,
939             PL_op, PL_op_name[PL_op->op_type], PL_op->op_next));
940 144           add_conditional(aTHX_ up, 3);
941 144 50         if (up->op_next == PL_op->op_next)
942 144           break;
943 0 0         up = OpSIBLING(cLOGOPx(up)->op_first)->op_next;
944             }
945             #endif
946 4303           add_conditional(aTHX_ PL_op, 3);
947            
948             #if PERL_VERSION > 18
949 4303           skipped = PL_op;
950 4303 50         while (skipped = find_skipped_conditional(aTHX_ skipped))
951 0           add_conditional(aTHX_ skipped, 2); /* Should this ever be 1? */
952             #endif
953             }
954             }
955             }
956            
957             #if PERL_VERSION > 16
958             /* A sequence of variable declarations may have been optimized
959              * to a single OP_PADRANGE. The original sequence may span multiple lines,
960              * but only the first line has been marked as covered for now.
961              * Mark other OP_NEXTSTATE inside the original sequence of statements.
962              */
963 18838           static void cover_padrange(pTHX) {
964             dMY_CXT;
965             OP *next,
966             *orig;
967 18838 50         if (!collecting(Statement)) return;
968 18838           next = PL_op->op_next;
969 18838 50         orig = OpSIBLING(PL_op);
970            
971             /* Ignore padrange preparing subroutine call */
972 95880 50         while (orig && orig != next) {
    100          
973 77042 50         if (orig->op_type == OP_ENTERSUB) return;
974 77042           orig = orig->op_next;
975             }
976 18838 50         orig = OpSIBLING(PL_op);
977 95880 50         while (orig && orig != next) {
    100          
978 77042 100         if (orig->op_type == OP_NEXTSTATE) {
979 49           cover_statement(aTHX_ orig);
980             }
981 77042           orig = orig->op_next;
982             }
983             }
984            
985 19961           static OP *dc_padrange(pTHX) {
986             dMY_CXT;
987 19961           check_if_collecting(aTHX_ PL_curcop);
988             NDEB(D(L, "dc_padrange() at %p (%d)\n", PL_op, collecting_here(aTHX)));
989 19961 100         if (MY_CXT.covering) cover_padrange(aTHX);
990 19961           return MY_CXT.ppaddr[OP_PADRANGE](aTHX);
991             }
992             #endif
993            
994 330205           static OP *dc_nextstate(pTHX) {
995             dMY_CXT;
996             NDEB(D(L, "dc_nextstate() at %p (%d)\n", PL_op, collecting_here(aTHX)));
997 330205 100         if (MY_CXT.covering) check_if_collecting(aTHX_ cCOP);
998 330205 100         if (collecting_here(aTHX)) cover_current_statement(aTHX);
999 330205           return MY_CXT.ppaddr[OP_NEXTSTATE](aTHX);
1000             }
1001            
1002             #if PERL_VERSION <= 10
1003             static OP *dc_setstate(pTHX) {
1004             dMY_CXT;
1005             NDEB(D(L, "dc_setstate() at %p (%d)\n", PL_op, collecting_here(aTHX)));
1006             if (MY_CXT.covering) check_if_collecting(aTHX_ cCOP);
1007             if (collecting_here(aTHX)) cover_current_statement(aTHX);
1008             return MY_CXT.ppaddr[OP_SETSTATE](aTHX);
1009             }
1010             #endif
1011            
1012 0           static OP *dc_dbstate(pTHX) {
1013             dMY_CXT;
1014             NDEB(D(L, "dc_dbstate() at %p (%d)\n", PL_op, collecting_here(aTHX)));
1015 0 0         if (MY_CXT.covering) check_if_collecting(aTHX_ cCOP);
1016 0 0         if (collecting_here(aTHX)) cover_current_statement(aTHX);
1017 0           return MY_CXT.ppaddr[OP_DBSTATE](aTHX);
1018             }
1019            
1020 87581           static OP *dc_entersub(pTHX) {
1021             dMY_CXT;
1022             NDEB(D(L, "dc_entersub() at %p (%d)\n", PL_op, collecting_here(aTHX)));
1023 87581 100         if (MY_CXT.covering) store_return(aTHX);
1024 87581           return MY_CXT.ppaddr[OP_ENTERSUB](aTHX);
1025             }
1026            
1027 37218           static OP *dc_cond_expr(pTHX) {
1028             dMY_CXT;
1029 37218           check_if_collecting(aTHX_ PL_curcop);
1030             NDEB(D(L, "dc_cond_expr() at %p (%d)\n", PL_op, collecting_here(aTHX)));
1031 37218 100         if (MY_CXT.covering && collecting_here(aTHX)) cover_cond(aTHX);
    100          
1032 37218           return MY_CXT.ppaddr[OP_COND_EXPR](aTHX);
1033             }
1034            
1035 103347           static OP *dc_and(pTHX) {
1036             dMY_CXT;
1037             NDEB(D(L, "dc_and() at %p (%d)\n", PL_op, collecting_here(aTHX)));
1038 103347           check_if_collecting(aTHX_ PL_curcop);
1039             NDEB(D(L, "dc_and() at %p (%d)\n", PL_curcop, collecting_here(aTHX)));
1040             NDEB(D(L, "PL_curcop: %s:%d\n", CopFILE(PL_curcop), CopLINE(PL_curcop)));
1041 103347 100         if (MY_CXT.covering && collecting_here(aTHX)) cover_logop(aTHX);
    100          
1042 103347           return MY_CXT.ppaddr[OP_AND](aTHX);
1043             }
1044            
1045 0           static OP *dc_andassign(pTHX) {
1046             dMY_CXT;
1047 0           check_if_collecting(aTHX_ PL_curcop);
1048             NDEB(D(L, "dc_andassign() at %p (%d)\n", PL_op, collecting_here(aTHX)));
1049 0 0         if (MY_CXT.covering && collecting_here(aTHX)) cover_logop(aTHX);
    0          
1050 0           return MY_CXT.ppaddr[OP_ANDASSIGN](aTHX);
1051             }
1052            
1053 34590           static OP *dc_or(pTHX) {
1054             dMY_CXT;
1055 34590           check_if_collecting(aTHX_ PL_curcop);
1056             NDEB(D(L, "dc_or() at %p (%d)\n", PL_op, collecting_here(aTHX)));
1057 34590 100         if (MY_CXT.covering && collecting_here(aTHX)) cover_logop(aTHX);
    100          
1058 34590           return MY_CXT.ppaddr[OP_OR](aTHX);
1059             }
1060            
1061 2289           static OP *dc_orassign(pTHX) {
1062             dMY_CXT;
1063 2289           check_if_collecting(aTHX_ PL_curcop);
1064             NDEB(D(L, "dc_orassign() at %p (%d)\n", PL_op, collecting_here(aTHX)));
1065 2289 100         if (MY_CXT.covering && collecting_here(aTHX)) cover_logop(aTHX);
    100          
1066 2289           return MY_CXT.ppaddr[OP_ORASSIGN](aTHX);
1067             }
1068            
1069             #if PERL_VERSION > 8
1070 0           static OP *dc_dor(pTHX) {
1071             dMY_CXT;
1072 0           check_if_collecting(aTHX_ PL_curcop);
1073             NDEB(D(L, "dc_dor() at %p (%d)\n", PL_op, collecting_here(aTHX)));
1074 0 0         if (MY_CXT.covering && collecting_here(aTHX)) cover_logop(aTHX);
    0          
1075 0           return MY_CXT.ppaddr[OP_DOR](aTHX);
1076             }
1077            
1078 3           static OP *dc_dorassign(pTHX) {
1079             dMY_CXT;
1080 3           check_if_collecting(aTHX_ PL_curcop);
1081             NDEB(D(L, "dc_dorassign() at %p (%d)\n", PL_op, collecting_here(aTHX)));
1082 3 50         if (MY_CXT.covering && collecting_here(aTHX)) cover_logop(aTHX);
    50          
1083 3           return MY_CXT.ppaddr[OP_DORASSIGN](aTHX);
1084             }
1085             #endif
1086            
1087 2           OP *dc_xor(pTHX) {
1088             dMY_CXT;
1089 2           check_if_collecting(aTHX_ PL_curcop);
1090             NDEB(D(L, "dc_xor() at %p (%d)\n", PL_op, collecting_here(aTHX)));
1091 2 50         if (MY_CXT.covering && collecting_here(aTHX)) cover_logop(aTHX);
    50          
1092 2           return MY_CXT.ppaddr[OP_XOR](aTHX);
1093             }
1094            
1095 23230           static OP *dc_require(pTHX) {
1096             dMY_CXT;
1097             NDEB(D(L, "dc_require() at %p (%d)\n", PL_op, collecting_here(aTHX)));
1098 23230 100         if (MY_CXT.covering && collecting_here(aTHX)) store_module(aTHX);
    100          
1099 23230           return MY_CXT.ppaddr[OP_REQUIRE](aTHX);
1100             }
1101            
1102 0           static OP *dc_exec(pTHX) {
1103             dMY_CXT;
1104             NDEB(D(L, "dc_exec() at %p (%d)\n", PL_op, collecting_here(aTHX)));
1105 0 0         if (MY_CXT.covering && collecting_here(aTHX)) call_report(aTHX);
    0          
1106 0           return MY_CXT.ppaddr[OP_EXEC](aTHX);
1107             }
1108            
1109 78           static void replace_ops (pTHX) {
1110             dMY_CXT;
1111             int i;
1112             NDEB(D(L, "initialising replace_ops\n"));
1113 30966 100         for (i = 0; i < MAXO; i++)
1114 30888           MY_CXT.ppaddr[i] = PL_ppaddr[i];
1115            
1116 78           PL_ppaddr[OP_NEXTSTATE] = dc_nextstate;
1117             #if PERL_VERSION <= 10
1118             PL_ppaddr[OP_SETSTATE] = dc_setstate;
1119             #endif
1120 78           PL_ppaddr[OP_DBSTATE] = dc_dbstate;
1121 78           PL_ppaddr[OP_ENTERSUB] = dc_entersub;
1122             #if PERL_VERSION > 16
1123 78           PL_ppaddr[OP_PADRANGE] = dc_padrange;
1124             #endif
1125 78           PL_ppaddr[OP_COND_EXPR] = dc_cond_expr;
1126 78           PL_ppaddr[OP_AND] = dc_and;
1127 78           PL_ppaddr[OP_ANDASSIGN] = dc_andassign;
1128 78           PL_ppaddr[OP_OR] = dc_or;
1129 78           PL_ppaddr[OP_ORASSIGN] = dc_orassign;
1130             #if PERL_VERSION > 8
1131 78           PL_ppaddr[OP_DOR] = dc_dor;
1132 78           PL_ppaddr[OP_DORASSIGN] = dc_dorassign;
1133             #endif
1134 78           PL_ppaddr[OP_XOR] = dc_xor;
1135 78           PL_ppaddr[OP_REQUIRE] = dc_require;
1136 78           PL_ppaddr[OP_EXEC] = dc_exec;
1137 78           }
1138            
1139 78           static void initialise(pTHX) {
1140             dMY_CXT;
1141            
1142             NDEB(D(L, "initialising\n"));
1143            
1144             MUTEX_LOCK(&DC_mutex);
1145 78 50         if (!Pending_conditionals) {
1146 78           Pending_conditionals = newHV();
1147             #ifdef USE_ITHREADS
1148             HvSHAREKEYS_off(Pending_conditionals);
1149             #endif
1150             }
1151 78 50         if (!Return_ops) {
1152 78           Return_ops = newHV();
1153             #ifdef USE_ITHREADS
1154             HvSHAREKEYS_off(Return_ops);
1155             #endif
1156             }
1157             MUTEX_UNLOCK(&DC_mutex);
1158            
1159 78           MY_CXT.collecting_here = 1;
1160            
1161 78 50         if (!MY_CXT.covering) {
1162             /* TODO - this probably leaks all over the place */
1163            
1164             SV **tmp;
1165            
1166 78           MY_CXT.cover = newHV();
1167             #ifdef USE_ITHREADS
1168             HvSHAREKEYS_off(MY_CXT.cover);
1169             #endif
1170            
1171 78           tmp = hv_fetch(MY_CXT.cover, "statement", 9, 1);
1172 78           MY_CXT.statements = newHV();
1173 78           *tmp = newRV_inc((SV*) MY_CXT.statements);
1174            
1175 78           tmp = hv_fetch(MY_CXT.cover, "branch", 6, 1);
1176 78           MY_CXT.branches = newHV();
1177 78           *tmp = newRV_inc((SV*) MY_CXT.branches);
1178            
1179 78           tmp = hv_fetch(MY_CXT.cover, "condition", 9, 1);
1180 78           MY_CXT.conditions = newHV();
1181 78           *tmp = newRV_inc((SV*) MY_CXT.conditions);
1182            
1183             #if CAN_PROFILE
1184 78           tmp = hv_fetch(MY_CXT.cover, "time", 4, 1);
1185 78           MY_CXT.times = newHV();
1186 78           *tmp = newRV_inc((SV*) MY_CXT.times);
1187             #endif
1188            
1189 78           tmp = hv_fetch(MY_CXT.cover, "module", 6, 1);
1190 78           MY_CXT.modules = newHV();
1191 78           *tmp = newRV_inc((SV*) MY_CXT.modules);
1192            
1193 78           MY_CXT.files = get_hv("Devel::Cover::Files", FALSE);
1194            
1195             #ifdef USE_ITHREADS
1196             HvSHAREKEYS_off(MY_CXT.statements);
1197             HvSHAREKEYS_off(MY_CXT.branches);
1198             HvSHAREKEYS_off(MY_CXT.conditions);
1199             #if CAN_PROFILE
1200             HvSHAREKEYS_off(MY_CXT.times);
1201             #endif
1202             HvSHAREKEYS_off(MY_CXT.modules);
1203             #endif
1204            
1205 78           MY_CXT.profiling_key_valid = 0;
1206 78           MY_CXT.module = newSVpv("", 0);
1207 78           MY_CXT.lastfile = newSVpvn("", 1);
1208 78           MY_CXT.covering = All;
1209 78           MY_CXT.tid = tid++;
1210            
1211 78 50         MY_CXT.replace_ops = SvTRUE(get_sv("Devel::Cover::Replace_ops", FALSE));
    50          
    0          
    50          
    0          
    0          
    50          
    50          
    50          
    50          
    50          
    50          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
1212             NDEB(D(L, "running with Replace_ops as %d\n", MY_CXT.replace_ops));
1213             }
1214 78           }
1215            
1216 0           static int runops_cover(pTHX) {
1217             dMY_CXT;
1218            
1219             NDEB(D(L, "entering runops_cover\n"));
1220            
1221             #if defined HAS_GETTIMEOFDAY
1222 0           elapsed();
1223             #elif defined HAS_TIMES
1224             cpu();
1225             #endif
1226            
1227             for (;;) {
1228             NDEB(D(L, "running func %p from %p (%s)\n",
1229             PL_op->op_ppaddr, PL_op, OP_NAME(PL_op)));
1230            
1231 0 0         if (!MY_CXT.covering)
1232 0           goto call_fptr;
1233            
1234             /* Nothing to collect when we've hijacked the ppaddr */
1235             {
1236             int hijacked;
1237             MUTEX_LOCK(&DC_mutex);
1238 0           hijacked = PL_op->op_ppaddr == get_condition;
1239             MUTEX_UNLOCK(&DC_mutex);
1240 0 0         if (hijacked)
1241 0           goto call_fptr;
1242             }
1243            
1244             /* Check to see whether we are interested in this file */
1245            
1246 0 0         if (PL_op->op_type == OP_NEXTSTATE)
1247 0           check_if_collecting(aTHX_ cCOP);
1248 0 0         else if (PL_op->op_type == OP_ENTERSUB)
1249 0           store_return(aTHX);
1250            
1251 0 0         if (!collecting_here(aTHX))
1252 0           goto call_fptr;
1253            
1254             /*
1255                      * We are about the run the op PL_op, so we'll collect
1256                      * information for it now
1257                      */
1258            
1259 0           switch (PL_op->op_type) {
1260             case OP_NEXTSTATE:
1261             #if PERL_VERSION <= 10
1262             case OP_SETSTATE:
1263             #endif
1264             case OP_DBSTATE: {
1265 0           cover_current_statement(aTHX);
1266 0           break;
1267             }
1268            
1269             #if PERL_VERSION > 16
1270             case OP_PADRANGE: {
1271 0           cover_padrange(aTHX);
1272 0           break;
1273             }
1274             #endif
1275            
1276             case OP_COND_EXPR: {
1277 0           cover_cond(aTHX);
1278 0           break;
1279             }
1280            
1281             case OP_AND:
1282             case OP_ANDASSIGN:
1283             case OP_OR:
1284             case OP_ORASSIGN:
1285             #if PERL_VERSION > 8
1286             case OP_DOR:
1287             case OP_DORASSIGN:
1288             #endif
1289             case OP_XOR: {
1290 0           cover_logop(aTHX);
1291 0           break;
1292             }
1293            
1294             case OP_REQUIRE: {
1295 0           store_module(aTHX);
1296 0           break;
1297             }
1298            
1299             case OP_EXEC: {
1300 0           call_report(aTHX);
1301 0           break;
1302             }
1303            
1304             default:
1305             ; /* IBM's xlC compiler on AIX is very picky */
1306             }
1307            
1308             call_fptr:
1309 0 0         if (!(PL_op = PL_op->op_ppaddr(aTHX)))
1310 0           break;
1311            
1312 0 0         PERL_ASYNC_CHECK();
1313 0           }
1314            
1315             #if CAN_PROFILE
1316 0           cover_time(aTHX);
1317             #endif
1318            
1319 0           MY_CXT.collecting_here = 1;
1320            
1321             NDEB(D(L, "exiting runops_cover\n"));
1322            
1323 0           TAINT_NOT;
1324 0           return 0;
1325             }
1326            
1327 0           static int runops_orig(pTHX) {
1328             NDEB(D(L, "entering runops_orig\n"));
1329            
1330 0 0         while ((PL_op = PL_op->op_ppaddr(aTHX))) {
1331 0 0         PERL_ASYNC_CHECK();
1332             }
1333            
1334             NDEB(D(L, "exiting runops_orig\n"));
1335            
1336 0           TAINT_NOT;
1337 0           return 0;
1338             }
1339            
1340 0           static int runops_trace(pTHX) {
1341 0           PDEB(D(L, "entering runops_trace\n"));
1342            
1343             for (;;) {
1344 0 0         PDEB(D(L, "running func %p from %p (%s)\n",
1345             PL_op->op_ppaddr, PL_op, OP_NAME(PL_op)));
1346            
1347 0 0         if (!(PL_op = PL_op->op_ppaddr(aTHX)))
1348 0           break;
1349            
1350 0 0         PERL_ASYNC_CHECK();
1351 0           }
1352            
1353 0           PDEB(D(L, "exiting runops_trace\n"));
1354            
1355 0           TAINT_NOT;
1356 0           return 0;
1357             }
1358            
1359             static char *svclassnames[] = {
1360             "B::NULL",
1361             "B::IV",
1362             "B::NV",
1363             "B::RV",
1364             "B::PV",
1365             "B::PVIV",
1366             "B::PVNV",
1367             "B::PVMG",
1368             "B::BM",
1369             "B::GV",
1370             "B::PVLV",
1371             "B::AV",
1372             "B::HV",
1373             "B::CV",
1374             "B::FM",
1375             "B::IO",
1376             };
1377            
1378 156           static SV *make_sv_object(pTHX_ SV *arg, SV *sv) {
1379             IV iv;
1380             char *type;
1381            
1382 156           iv = PTR2IV(sv);
1383 156           type = svclassnames[SvTYPE(sv)];
1384 156           sv_setiv(newSVrv(arg, type), iv);
1385 156           return arg;
1386             }
1387            
1388            
1389             typedef OP *B__OP;
1390             typedef AV *B__AV;
1391            
1392            
1393             MODULE = Devel::Cover PACKAGE = Devel::Cover
1394            
1395             PROTOTYPES: ENABLE
1396            
1397             void
1398             set_criteria(flag)
1399             unsigned flag
1400             PREINIT:
1401             dMY_CXT;
1402             PPCODE:
1403 236           MY_CXT.covering = flag;
1404             /* fprintf(stderr, "Cover set to %d\n", flag); */
1405 236 50         if (MY_CXT.replace_ops) return;
1406 0 0         PL_runops = MY_CXT.covering ? runops_cover : runops_orig;
1407            
1408             void
1409             add_criteria(flag)
1410             unsigned flag
1411             PREINIT:
1412             dMY_CXT;
1413             PPCODE:
1414 1           MY_CXT.covering |= flag;
1415 1 50         if (MY_CXT.replace_ops) return;
1416 0 0         PL_runops = MY_CXT.covering ? runops_cover : runops_orig;
1417            
1418             void
1419             remove_criteria(flag)
1420             unsigned flag
1421             PREINIT:
1422             dMY_CXT;
1423             PPCODE:
1424 1           MY_CXT.covering &= ~flag;
1425 1 50         if (MY_CXT.replace_ops) return;
1426 0 0         PL_runops = MY_CXT.covering ? runops_cover : runops_orig;
1427            
1428             unsigned
1429             get_criteria()
1430             PREINIT:
1431             dMY_CXT;
1432             CODE:
1433 238           RETVAL = MY_CXT.covering;
1434             OUTPUT:
1435             RETVAL
1436            
1437             unsigned
1438             coverage_none()
1439             CODE:
1440 79           RETVAL = None;
1441             OUTPUT:
1442             RETVAL
1443            
1444             unsigned
1445             coverage_statement()
1446             CODE:
1447 78           RETVAL = Statement;
1448             OUTPUT:
1449             RETVAL
1450            
1451             unsigned
1452             coverage_branch()
1453             CODE:
1454 78           RETVAL = Branch;
1455             OUTPUT:
1456             RETVAL
1457            
1458             unsigned
1459             coverage_condition()
1460             CODE:
1461 78           RETVAL = Condition;
1462             OUTPUT:
1463             RETVAL
1464            
1465             unsigned
1466             coverage_subroutine()
1467             CODE:
1468 78           RETVAL = Subroutine;
1469             OUTPUT:
1470             RETVAL
1471            
1472             unsigned
1473             coverage_path()
1474             CODE:
1475 78           RETVAL = Path;
1476             OUTPUT:
1477             RETVAL
1478            
1479             unsigned
1480             coverage_pod()
1481             CODE:
1482 78           RETVAL = Pod;
1483             OUTPUT:
1484             RETVAL
1485            
1486             unsigned
1487             coverage_time()
1488             CODE:
1489 78           RETVAL = Time;
1490             OUTPUT:
1491             RETVAL
1492            
1493             unsigned
1494             coverage_all()
1495             CODE:
1496 79           RETVAL = All;
1497             OUTPUT:
1498             RETVAL
1499            
1500             double
1501             get_elapsed()
1502             CODE:
1503             #ifdef HAS_GETTIMEOFDAY
1504 156           RETVAL = get_elapsed();
1505             #else
1506             RETVAL = 0;
1507             #endif
1508             OUTPUT:
1509             RETVAL
1510            
1511             SV *
1512             coverage(final)
1513             unsigned final
1514             PREINIT:
1515             dMY_CXT;
1516             CODE:
1517             NDEB(D(L, "Getting coverage %d\n", final));
1518 20526 100         if (final) finalise_conditions(aTHX);
1519 20526 50         if (MY_CXT.cover)
1520 20526           RETVAL = newRV_inc((SV*) MY_CXT.cover);
1521             else
1522 0           RETVAL = &PL_sv_undef;
1523             OUTPUT:
1524             RETVAL
1525            
1526             SV *
1527             get_key(o)
1528             B::OP o
1529             CODE:
1530 376           RETVAL = newSV(KEY_SZ + 1);
1531 376           sv_setpvn(RETVAL, get_key(o), KEY_SZ);
1532             OUTPUT:
1533             RETVAL
1534            
1535             void
1536             set_first_init_and_end()
1537             PPCODE:
1538 78           set_firsts_if_needed(aTHX);
1539            
1540             void
1541             collect_inits()
1542             PREINIT:
1543             dMY_CXT;
1544             PPCODE:
1545             int i;
1546             NDEB(svdump(end));
1547 78 50         if (!MY_CXT.ends) MY_CXT.ends = newAV();
1548 78 50         if (PL_initav)
1549 233 100         for (i = 0; i <= av_len(PL_initav); i++) {
1550 155           SV **cv = av_fetch(PL_initav, i, 0);
1551 155           SvREFCNT_inc(*cv);
1552 155           av_push(MY_CXT.ends, *cv);
1553             }
1554            
1555             void
1556             set_last_end()
1557             PREINIT:
1558             dMY_CXT;
1559             PPCODE:
1560             int i;
1561 78           SV *end = (SV *)get_cv("last_end", 0);
1562 78           av_push(PL_endav, end);
1563             NDEB(svdump(end));
1564 78 50         if (!MY_CXT.ends) MY_CXT.ends = newAV();
1565 78 50         if (PL_endav)
1566 686 100         for (i = 0; i <= av_len(PL_endav); i++) {
1567 608           SV **cv = av_fetch(PL_endav, i, 0);
1568 608           SvREFCNT_inc(*cv);
1569 608           av_push(MY_CXT.ends, *cv);
1570             }
1571            
1572             B::AV
1573             get_ends()
1574             PREINIT:
1575             dMY_CXT;
1576             CODE:
1577 156 50         if (!MY_CXT.ends) MY_CXT.ends = newAV(); /* TODO: how? */
1578 156           RETVAL = MY_CXT.ends;
1579             OUTPUT:
1580             RETVAL
1581            
1582             BOOT:
1583             {
1584             MY_CXT_INIT;
1585             #ifdef USE_ITHREADS
1586             MUTEX_INIT(&DC_mutex);
1587             #endif
1588 78           initialise(aTHX);
1589 78 50         if (MY_CXT.replace_ops) {
1590 78           replace_ops(aTHX);
1591             #if defined HAS_GETTIMEOFDAY
1592 78           elapsed();
1593             #elif defined HAS_TIMES
1594             cpu();
1595             #endif
1596             /* PL_runops = runops_trace; */
1597             } else {
1598 0           PL_runops = runops_cover;
1599             }
1600             #if PERL_VERSION > 6
1601 78           PL_savebegin = TRUE;
1602             #endif
1603             }
1604