forked from pjcj/Devel--Cover
/
Cover.xs
75 lines (62 loc) · 1.34 KB
/
Cover.xs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
/*
* Copyright 2001, Paul Johnson (pjcj@cpan.org)
*
* This software is free. It is licensed under the same terms as Perl itself.
*
* The latest version of this software should be available from my homepage:
* http://www.pjcj.net
*
*/
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#ifdef PERL_OBJECT
#define CALLOP this->*PL_op
#else
#define CALLOP *PL_op
#endif
static int covering = 1;
HV *hv = 0;
union address /* Hack, hack, hackety hack. */
{
char ch[sizeof(PL_op) + 1];
void *plop;
};
static int
runops_cover(pTHX)
{
union address addr;
SV **count;
IV c;
if (!hv) hv = newHV();
addr.ch[sizeof(PL_op)] = '\0';
while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX))) {
if (covering)
{
addr.plop = PL_op;
count = hv_fetch(hv, addr.ch, sizeof(PL_op), 1);
c = SvTRUE(*count) ? SvIV(*count) + 1 : 1;
sv_setiv(*count, c);
}
PERL_ASYNC_CHECK();
}
TAINT_NOT;
return 0;
}
MODULE = Devel::Cover PACKAGE = Devel::Cover
PROTOTYPES: ENABLE
void
set_cover(flag)
int flag
PPCODE:
covering = flag;
SV *
coverage()
CODE:
ST(0) = sv_newmortal();
if (hv)
sv_setsv(ST(0), newRV_inc((SV*) hv));
else
ST(0) = &PL_sv_undef;
BOOT:
PL_runops = runops_cover;