Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

831 lines (676 sloc) 19.444 kb
/*
* Copyright 2001-2004, 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
*
*/
#ifdef __cplusplus
extern "C" {
#endif
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#ifdef __cplusplus
}
#endif
#ifdef PERL_OBJECT
#define CALLOP this->*PL_op
#else
#define CALLOP *PL_op
#endif
#define PDEB(a) a
#define NDEB(a)
#define D PerlIO_printf
#define L Perl_debug_log
#define svdump(sv) do_sv_dump(0, L, (SV *)sv, 0, 10, 1, 0);
#define None 0x00000000
#define Statement 0x00000001
#define Branch 0x00000002
#define Condition 0x00000004
#define Subroutine 0x00000008
#define Path 0x00000010
#define Pod 0x00000020
#define Time 0x00000040
#define All 0xffffffff
static unsigned Covering = All; /* Until we find out what we really want */
#define collecting(criteria) (Covering & (criteria))
static HV *Cover_hv,
*Statements,
*Branches,
*Conditions,
*Times,
*Pending_conditionals;
static OP *Profiling_op = 0;
#define ch_sz (sizeof(void *) + sizeof(PADOFFSET))
struct unique /* Well, we'll be fairly unlucky if it's not */
{
void *addr;
PADOFFSET pad;
};
union sequence /* Hack, hack, hackety hack. */
{
struct unique op;
char ch[ch_sz + 1];
};
#ifdef HAS_GETTIMEOFDAY
#ifdef __cplusplus
extern "C" {
#endif
#ifdef WIN32
#include <time.h>
#else
#include <sys/time.h>
#endif
#ifdef __cplusplus
}
#endif
static double get_elapsed()
{
struct timeval time;
double e;
gettimeofday(&time, NULL);
e = time.tv_sec * 1e6 + time.tv_usec;
/* fprintf(stderr, "[[[%f]]]\n", e); */
return e;
}
static double elapsed()
{
static double p;
double e, t;
t = get_elapsed();
e = t - p;
p = t;
return e;
}
#endif /* HAS_GETTIMEOFDAY */
#ifdef HAS_TIMES
#ifndef HZ
# ifdef CLK_TCK
# define HZ CLK_TCK
# else
# define HZ 60
# endif
#endif
static int cpu()
{
static struct tms time;
static int utime = 0,
stime = 0;
int e;
#ifndef VMS
(void)PerlProc_times(&time);
#else
(void)PerlProc_times((tbuffer_t *)&time);
#endif
e = time.tms_utime - utime + time.tms_stime - stime;
utime = time.tms_utime;
stime = time.tms_stime;
/* fprintf(stderr, "<<<%d>>>\n", utime + stime); */
return e / HZ;
}
#endif /* HAS_TIMES */
#define CAN_PROFILE defined HAS_GETTIMEOFDAY || defined HAS_TIMES
static char *get_key(OP *o)
{
static union sequence uniq;
uniq.op.addr = o;
uniq.op.pad = o->op_targ;
uniq.ch[ch_sz] = 0;
NDEB(D(L, "0x%x 0x%x => <%s>\n", o, o->op_targ, uniq.ch));
return uniq.ch;
}
static void add_branch(OP *op, int br)
{
AV *branches;
SV **count;
int c;
SV **tmp = hv_fetch(Branches, get_key(op), ch_sz, 1);
if (SvROK(*tmp))
branches = (AV *) SvRV(*tmp);
else
{
*tmp = newRV_inc((SV*) (branches = newAV()));
av_unshift(branches, 2);
}
count = av_fetch(branches, br, 1);
c = SvTRUE(*count) ? SvIV(*count) + 1 : 1;
sv_setiv(*count, c);
NDEB(D(L, "Adding branch making %d at %p\n", c, op));
}
static AV *get_conditional_array(OP *op)
{
AV *conds;
SV **tmp = hv_fetch(Conditions, get_key(op), ch_sz, 1);
if (SvROK(*tmp))
conds = (AV *) SvRV(*tmp);
else
*tmp = newRV_inc((SV*) (conds = newAV()));
return conds;
}
static void set_conditional(OP *op, int cond, int value)
{
SV **count;
AV *conds = get_conditional_array(op);
/*
* The conditional array comprises five elements:
*
* 0 - 1 iff we are in an xor and the first operand was true
* 1 - not short circuited - second operand is false
* 2 - not short circuited - second operand is true
* 3 - short circuited, or for xor second operand is false
* 4 - for xor second operand is true
*/
count = av_fetch(conds, cond, 1);
sv_setiv(*count, value);
NDEB(D(L, "Setting %d conditional to %d at %p\n", cond, value, op));
}
static void add_conditional(OP *op, int cond)
{
SV **count;
int c;
AV *conds = get_conditional_array(op);
count = av_fetch(conds, cond, 1);
c = SvTRUE(*count) ? SvIV(*count) + 1 : 1;
sv_setiv(*count, c);
NDEB(D(L, "Adding %d conditional making %d at %p\n", cond, c, op));
}
static void finalise_conditions()
{
/*
* Our algorithm for conditions relies on ending up at a particular
* op which we use to call get_condition(). It's possible that we
* never get to that op; for example we might return out of a sub.
* This causes us to lose coverage information.
*
* This function is called when the program has been run in order to
* collect that lost information.
*/
HE *e;
I32 i = hv_iterinit(Pending_conditionals);
while (e = hv_iternext(Pending_conditionals))
{
SV *sv = hv_iterval(Pending_conditionals, e);
AV *conds = (AV *) SvRV(sv);
NDEB(D(L, "Looking through %d conditionals\n", av_len(conds)));
for (i = 1; i <= av_len(conds); i++)
{
SV **sv = av_fetch(conds, i, 0);
OP *op = (OP *) SvIV(*sv);
{
dSP;
SV **count;
int type;
AV *cond_array = get_conditional_array(op);
int value;
/*
* Since we are here we know that the condition was not
* short circuited. We also know that the other operand
* must have made the condition true, otherwise we would
* have reached the op we were expecting to reach.
*/
count = av_fetch(cond_array, 0, 1);
type = SvTRUE(*count) ? SvIV(*count) : 0;
sv_setiv(*count, 0);
/* Check if we have come from an xor with a true first op */
value = (type == 1) ? 3 : 2;
NDEB(D(L, "%3d: Found %p\n", i, PL_op));
add_conditional(op, value);
}
}
av_clear(conds);
}
}
static OP *get_condition(pTHX)
{
char *ch = get_key(PL_op);
SV **sv = hv_fetch(Pending_conditionals, ch, ch_sz, 0);
NDEB(D(L, "In get_condition\n"));
if (sv && SvROK(*sv))
{
OP *(*f)(pTHX);
AV *conds = (AV *) SvRV(*sv);
I32 i;
NDEB(D(L, "Looking through %d conditionals\n", av_len(conds)));
sv = av_fetch(conds, 0, 0);
f = (OP *(*)(pTHX)) SvIV(*sv);
for (i = 1; i <= av_len(conds); i++)
{
OP *op;
sv = av_fetch(conds, i, 0);
op = (OP *) SvIV(*sv);
{
dSP;
SV **count;
int type;
AV *cond_array = get_conditional_array(op);
int value = SvTRUE(TOPs) ? 2 : 1;
count = av_fetch(cond_array, 0, 1);
type = SvTRUE(*count) ? SvIV(*count) : 0;
sv_setiv(*count, 0);
/* Check if we have come from an xor with a true first op */
if (type == 1)
value += 2;
NDEB(D(L, "%3d: Found %p\n", i, PL_op));
add_conditional(op, value);
}
}
av_clear(conds);
NDEB(D(L, "f is %p\n", f));
PL_op->op_ppaddr = f;
}
else
{
Perl_croak(aTHX_
"All is lost, I know not where to go from %p, %p: %p\n",
PL_op, PL_op->op_targ, sv);
}
return PL_op;
}
static void cover_cond()
{
if (collecting(Branch))
{
dSP;
int val = SvTRUE(TOPs);
add_branch(PL_op, !val);
}
}
static void cover_logop()
{
/*
* For OP_AND, if the first operand is false, we have short
* circuited the second, otherwise the value of the and op is the
* value of the second operand.
*
* For OP_OR, if the first operand is true, we have short circuited
* the second, otherwise the value of the and op is the value of the
* second operand.
*
* We check the value of the first operand by simply looking on the
* stack. To check the second operand it is necessary to note the
* location of the next op after this logop. When we get there, we
* look at the stack and store the coverage information indexed to
* this op.
*
* This scheme also works for OP_XOR with a small modification
* because it doesn't short circuit. See the comment below.
*
* To find out when we get to the next op we change the op_ppaddr to
* point to get_condition(), which will do the necessary work and
* then reset and run the original op_ppaddr. We also store
* information in the Pending_conditionals hash. This is keyed on
* the op and the value is an array, the first element of which is
* the op_ppaddr we overwrote, and the subsequent elements are the
* ops about which we are collecting the condition coverage
* information. Note that an op may be collecting condition
* coverage information about a number of conditions.
*/
if (!collecting(Condition))
return;
if (cLOGOP->op_first->op_type == OP_ITER)
{
/* loop - ignore it for now*/
}
else
{
dSP;
int left_val = SvTRUE(TOPs);
if (PL_op->op_type == OP_AND && left_val ||
PL_op->op_type == OP_ANDASSIGN && left_val ||
PL_op->op_type == OP_OR && !left_val ||
PL_op->op_type == OP_ORASSIGN && !left_val ||
PL_op->op_type == OP_XOR)
{
/* no short circuit */
OP *right = cLOGOP->op_first->op_sibling;
NDEB(op_dump(right));
if (right->op_type == OP_NEXT ||
right->op_type == OP_LAST ||
right->op_type == OP_REDO ||
right->op_type == OP_REDO ||
right->op_type == OP_GOTO ||
right->op_type == OP_RETURN)
{
/*
* If the right side of the op is a branch, we don't
* care what its value is - it won't be returning one.
* We're just glad to be here, so we chalk up success.
*/
add_conditional(PL_op, 2);
}
else
{
char *ch;
AV *conds;
SV **tmp,
*cond;
OP *next;
if (PL_op->op_type == OP_XOR && left_val)
{
/*
* This is an xor. It does not short circuit. We
* have just executed the first op. When we get to
* next we will have already done the xor, so we can
* work out what the value of the second op was.
*
* We set a flag in the first element of the array
* to say that we had a true value from the first
* op.
*/
set_conditional(PL_op, 0, 1);
}
NDEB(op_dump(PL_op));
next = PL_op->op_next;
ch = get_key(next);
tmp = hv_fetch(Pending_conditionals, ch, ch_sz, 1);
if (SvROK(*tmp))
conds = (AV *)SvRV(*tmp);
else
*tmp = newRV_inc((SV*) (conds = newAV()));
if (av_len(conds) < 0)
{
SV *ppaddr = newSViv((IV) next->op_ppaddr);
av_push(conds, ppaddr);
NDEB(D(L, "setting f to %p\n", next->op_ppaddr));
}
cond = newSViv((IV) PL_op);
av_push(conds, cond);
NDEB(D(L, "Adding conditional %p to %p, making %d\n",
next, next->op_targ, av_len(conds)));
NDEB(svdump(Pending_conditionals));
NDEB(op_dump(PL_op));
NDEB(op_dump(next));
next->op_ppaddr = get_condition;
}
}
else
{
/* short circuit */
add_conditional(PL_op, 3);
}
}
}
#if CAN_PROFILE
static void cover_time()
{
SV **count;
NV c;
char *ch;
if (collecting(Time))
{
/*
* Profiling information is stored against Profiling_op, the one
* we have just run.
*/
NDEB(D(L, "Cop at %p, op at %p, timing %p\n", PL_curcop, PL_op, Profiling_op));
if (Profiling_op)
{
ch = get_key(Profiling_op);
count = hv_fetch(Times, ch, ch_sz, 1);
c = (SvTRUE(*count) ? SvNV(*count) : 0) +
#if defined HAS_GETTIMEOFDAY
elapsed();
#else
cpu();
#endif
sv_setnv(*count, c);
NDEB(D(L, "Adding time: sum %f at %p\n", c, Profiling_op));
}
Profiling_op = PL_op;
}
}
#endif
static int runops_cover(pTHX)
{
SV **count;
IV c;
char *ch;
HV *Files = 0;
int collecting_here = 1;
char *lastfile = 0;
NDEB(D(L, "runops_cover\n"));
if (!Cover_hv)
{
/* TODO - this probably leaks all over the place */
SV **tmp;
Cover_hv = newHV();
tmp = hv_fetch(Cover_hv, "statement", 9, 1);
Statements = newHV();
*tmp = newRV_inc((SV*) Statements);
tmp = hv_fetch(Cover_hv, "branch", 6, 1);
Branches = newHV();
*tmp = newRV_inc((SV*) Branches);
tmp = hv_fetch(Cover_hv, "condition", 9, 1);
Conditions = newHV();
*tmp = newRV_inc((SV*) Conditions);
#if CAN_PROFILE
tmp = hv_fetch(Cover_hv, "time", 4, 1);
Times = newHV();
*tmp = newRV_inc((SV*) Times);
#endif
Pending_conditionals = newHV();
}
#if defined HAS_GETTIMEOFDAY
elapsed();
#elif defined HAS_TIMES
cpu();
#endif
for (;;)
{
NDEB(D(L, "running func %p\n", PL_op->op_ppaddr));
if (!Covering)
goto call_fptr;
/* Nothing to collect when we've hijacked the ppaddr */
if (PL_op->op_ppaddr == get_condition)
goto call_fptr;
/* Check to see whether we are interested in this file */
if (PL_op->op_type == OP_NEXTSTATE)
{
char *file = CopFILE(cCOP);
if (file && (!lastfile || lastfile && strNE(lastfile, file)))
{
if (!Files)
Files = get_hv("Devel::Cover::Files", FALSE);
if (Files)
{
SV **f = hv_fetch(Files, file, strlen(file), 0);
collecting_here = f ? SvIV(*f) : 1;
NDEB(D(L, "File: %s [%d]\n", file, collecting_here));
}
lastfile = file;
}
}
if (!collecting_here)
{
#if CAN_PROFILE
cover_time();
Profiling_op = 0;
#endif
goto call_fptr;
}
/*
* We are about the run the op PL_op, so we'll collect
* information for it now.
*/
switch (PL_op->op_type)
{
case OP_SETSTATE:
case OP_NEXTSTATE:
case OP_DBSTATE:
{
#if CAN_PROFILE
cover_time();
#endif
if (collecting(Statement))
{
ch = get_key(PL_op);
count = hv_fetch(Statements, ch, ch_sz, 1);
c = SvTRUE(*count) ? SvIV(*count) + 1 : 1;
sv_setiv(*count, c);
NDEB(op_dump(PL_op));
}
break;
}
case OP_COND_EXPR:
{
cover_cond();
break;
}
case OP_AND:
case OP_OR:
case OP_ANDASSIGN:
case OP_ORASSIGN:
case OP_XOR:
{
cover_logop();
break;
}
default:
; /* IBM's xlC compiler on AIX is very picky */
}
call_fptr:
if (!(PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX)))
{
#if CAN_PROFILE
cover_time();
#endif
break;
}
PERL_ASYNC_CHECK();
}
TAINT_NOT;
return 0;
}
static int runops_orig(pTHX)
{
NDEB(D(L, "runops_orig\n"));
while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX)))
{
PERL_ASYNC_CHECK();
}
TAINT_NOT;
return 0;
}
#if 0
static void cv_destroy_cb(pTHX_ CV *cv)
{
SV *sv;
IV iv;
dSP;
PDEB(D(L, "cv_destroy_cb %p - %p\n", cv, Covering));
if (!Covering)
return;
ENTER;
SAVETMPS;
PUSHMARK(SP);
sv = sv_newmortal();
iv = PTR2IV(cv);
sv_setiv(newSVrv(sv, "B::CV"), iv);
XPUSHs(sv);
/* XPUSHs(sv_2mortal(newSViv(cv))); */
PUTBACK;
call_pv("Devel::Cover::get_cover_x", G_DISCARD);
FREETMPS;
LEAVE;
NDEB(svdump(cv));
}
#endif
MODULE = Devel::Cover PACKAGE = Devel::Cover
PROTOTYPES: ENABLE
void
set_criteria(flag)
unsigned flag
PPCODE:
/* fprintf(stderr, "Cover set to %d\n", flag); */
PL_runops = (Covering = flag) ? runops_cover : runops_orig;
void
add_criteria(flag)
unsigned flag
PPCODE:
PL_runops = (Covering |= flag) ? runops_cover : runops_orig;
void
remove_criteria(flag)
unsigned flag
PPCODE:
PL_runops = (Covering &= ~flag) ? runops_cover : runops_orig;
unsigned
get_criteria()
CODE:
RETVAL = Covering;
OUTPUT:
RETVAL
unsigned
coverage_none()
CODE:
RETVAL = None;
OUTPUT:
RETVAL
unsigned
coverage_statement()
CODE:
RETVAL = Statement;
OUTPUT:
RETVAL
unsigned
coverage_branch()
CODE:
RETVAL = Branch;
OUTPUT:
RETVAL
unsigned
coverage_condition()
CODE:
RETVAL = Condition;
OUTPUT:
RETVAL
unsigned
coverage_subroutine()
CODE:
RETVAL = Subroutine;
OUTPUT:
RETVAL
unsigned
coverage_path()
CODE:
RETVAL = Path;
OUTPUT:
RETVAL
unsigned
coverage_pod()
CODE:
RETVAL = Pod;
OUTPUT:
RETVAL
unsigned
coverage_time()
CODE:
RETVAL = Time;
OUTPUT:
RETVAL
unsigned
coverage_all()
CODE:
RETVAL = All;
OUTPUT:
RETVAL
double
get_elapsed()
SV *
coverage()
CODE:
finalise_conditions();
ST(0) = sv_newmortal();
if (Cover_hv)
sv_setsv(ST(0), newRV_inc((SV*) Cover_hv));
else
ST(0) = &PL_sv_undef;
BOOT:
/* PL_runops = runops_orig; */
/* PL_savebegin = TRUE; */
/* PL_savecheck = TRUE; */
/* PL_saveinit = TRUE; */
/* PL_saveend = TRUE; */
/* PL_cv_destroy_cb = cv_destroy_cb; */
Jump to Line
Something went wrong with that request. Please try again.