[Jifty-commit] r5432 - in Runops-Trace/trunk: . lib/Runops
Jifty commits
jifty-commit at lists.jifty.org
Sat May 10 09:44:14 EDT 2008
Author: nothingmuch
Date: Sat May 10 09:44:14 2008
New Revision: 5432
Modified:
Runops-Trace/trunk/Trace.xs
Runops-Trace/trunk/lib/Runops/Trace.pm
Runops-Trace/trunk/t/01compile.t
Runops-Trace/trunk/t/02mapstart.t
Runops-Trace/trunk/t/03given.t
Runops-Trace/trunk/t/04features.t
Runops-Trace/trunk/t/05printtofh.t
Runops-Trace/trunk/t/06counters.t
Runops-Trace/trunk/t/07perl_Hook.t
Runops-Trace/trunk/t/08fact.t
Log:
various fixes, API corrections, and 5.8 test passing
Modified: Runops-Trace/trunk/Trace.xs
==============================================================================
--- Runops-Trace/trunk/Trace.xs (original)
+++ Runops-Trace/trunk/Trace.xs Sat May 10 09:44:14 2008
@@ -8,17 +8,17 @@
int (*Runops_Trace_old_runops ) ( pTHX );
-bool (*Runops_Trace_hook)(pTHX);
+int (*Runops_Trace_hook)(pTHX);
static HV *Runops_Trace_op_counters;
-static bool Runops_Trace_enabled;
+static int Runops_Trace_enabled;
static UV Runops_Trace_threshold = 0;
static SV *Runops_Trace_perl_hook;
-static bool Runops_Trace_perl_ignore_ret = 1;
+static int Runops_Trace_perl_ignore_ret = 1;
-static bool Runops_Trace_loaded_B;
+static int Runops_Trace_loaded_B;
static GV *Runops_Trace_B_UNOP_stash;
static UNOP Runops_Trace_fakeop;
static SV *Runops_Trace_fakeop_sv;
@@ -148,7 +148,7 @@
}
/* this is a hook that calls to a perl code ref */
-bool
+int
Runops_Trace_perl (pTHX) {
dSP;
@@ -157,10 +157,13 @@
SV *sv_ret;
SV *PL_op_object;
- bool ret;
+ int ret;
IV arity;
if (Runops_Trace_threshold != 0) {
+ SV **count;
+ UV c;
+
/* having a threshold means that only ops that are hit enough
* times get hooked, the idea is that this can be used for
* trace caching */
@@ -169,8 +172,8 @@
Runops_Trace_op_counters = newHV();
/* unfortunately we need to keep the counters in a hash */
- SV **count = hv_fetch(Runops_Trace_op_counters, (char *)PL_op, sizeof(PL_op), 1);
- UV c = SvTRUE(*count) ? SvUV(*count) + 1 : 1;
+ count = hv_fetch(Runops_Trace_op_counters, (char *)PL_op, sizeof(PL_op), 1);
+ c = SvTRUE(*count) ? SvUV(*count) + 1 : 1;
sv_setuv(*count, c);
/* if we haven't reached the threshold yet, then return */
@@ -281,7 +284,7 @@
}
void
-Runops_Trace_set_hook (bool (*hook)(pTHX)) {
+Runops_Trace_set_hook (int (*hook)(pTHX)) {
Runops_Trace_hook = hook;
}
@@ -295,7 +298,7 @@
void
Runops_Trace_load_B (pTHX) {
if (!Runops_Trace_loaded_B) {
- load_module( PERL_LOADMOD_NOIMPORT, newSVpv("B", 0), newSViv(0) );
+ load_module( PERL_LOADMOD_NOIMPORT, newSVpv("B", 0), (SV *)NULL );
Runops_Trace_fakeop_sv = sv_bless(newRV_noinc(newSVuv((UV)&Runops_Trace_fakeop)), gv_stashpv("B::UNOP", 0));
Runops_Trace_loaded_B = 1;
}
@@ -355,8 +358,8 @@
OUTPUT:
RETVAL
-bool
-enabled()
+int
+tracing_enabled()
CODE:
{
RETVAL = Runops_Trace_enabled;
@@ -365,21 +368,21 @@
RETVAL
void
-enable()
+enable_tracing()
CODE:
{
Runops_Trace_enable();
}
void
-disable()
+disable_tracing()
CODE:
{
Runops_Trace_disable();
}
UV
-get_threshold()
+get_trace_threshold()
CODE:
{
RETVAL = Runops_Trace_get_threshold();
@@ -388,21 +391,21 @@
RETVAL
void
-set_threshold(SV *a)
+set_trace_threshold(SV *a)
CODE:
{
Runops_Trace_set_threshold(SvUV(a));
}
void
-set_hook(SV *hook)
+set_tracer(SV *hook)
CODE:
{
Runops_Trace_set_perl_hook(aTHX_ hook);
}
void
-clear_hook()
+clear_tracer()
CODE:
{
Runops_Trace_clear_perl_hook(aTHX);
Modified: Runops-Trace/trunk/lib/Runops/Trace.pm
==============================================================================
--- Runops-Trace/trunk/lib/Runops/Trace.pm (original)
+++ Runops-Trace/trunk/lib/Runops/Trace.pm Sat May 10 09:44:14 2008
@@ -11,7 +11,14 @@
our @ISA = qw( DynaLoader Exporter );
Runops::Trace->bootstrap($VERSION);
-our @EXPORT_OK = qw( trace_code checksum_code_path trace );
+our @EXPORT_OK = qw(
+ trace_code checksum_code_path trace
+
+ set_tracer enable_tracing disable_tracing tracing_enabled
+
+ set_trace_threshold get_trace_threshold counters
+);
+
our %EXPORT_TAGS = ( 'all' => \@EXPORT_OK );
sub checksum_code_path {
@@ -54,6 +61,8 @@
=head1 SYNOPSIS
+Per function tracing:
+
use Runops::Trace 'checksum_code_path';
sub is_even { shift() % 2 == 0 ? 1 : 0 }
@@ -70,6 +79,8 @@
}
print join ' ', keys %sufficient;
+Global tracing
+
=head1 DESCRIPTION
This module traces opcodes as they are executed by the perl VM. The
@@ -105,9 +116,13 @@
=item STRING = trace_code( FUNCTION )
+=item ARRAY = trace_code( FUNCTION )
+
This returns a string representing the ops that were executed. Each op
is represented as its name and hex address in memory.
+If called in list context will return the list of L<B::OP> objects.
+
=back
=head1 PERL HACKS COMPATIBILITY
Modified: Runops-Trace/trunk/t/01compile.t
==============================================================================
--- Runops-Trace/trunk/t/01compile.t (original)
+++ Runops-Trace/trunk/t/01compile.t Sat May 10 09:44:14 2008
@@ -3,7 +3,7 @@
use Test::More tests => 4;
use_ok('Runops::Trace');
-Runops::Trace::enable();
+Runops::Trace::enable_tracing();
pass('and it continues to work');
eval { pass('... in eval {}') };
Modified: Runops-Trace/trunk/t/02mapstart.t
==============================================================================
--- Runops-Trace/trunk/t/02mapstart.t (original)
+++ Runops-Trace/trunk/t/02mapstart.t Sat May 10 09:44:14 2008
@@ -1,7 +1,7 @@
#!perl
use Runops::Trace;
-BEGIN { Runops::Trace::enable() }
+BEGIN { Runops::Trace::enable_tracing() }
use Test::More tests => 1;
Modified: Runops-Trace/trunk/t/03given.t
==============================================================================
--- Runops-Trace/trunk/t/03given.t (original)
+++ Runops-Trace/trunk/t/03given.t Sat May 10 09:44:14 2008
@@ -4,7 +4,7 @@
use warnings;
use Runops::Trace;
-BEGIN { Runops::Trace::enable() }
+BEGIN { Runops::Trace::enable_tracing() }
use Test::More;
Modified: Runops-Trace/trunk/t/04features.t
==============================================================================
--- Runops-Trace/trunk/t/04features.t (original)
+++ Runops-Trace/trunk/t/04features.t Sat May 10 09:44:14 2008
@@ -4,7 +4,7 @@
use warnings;
use Runops::Trace;
-BEGIN { Runops::Trace::enable() }
+BEGIN { Runops::Trace::enable_tracing() }
use Test::More;
Modified: Runops-Trace/trunk/t/05printtofh.t
==============================================================================
--- Runops-Trace/trunk/t/05printtofh.t (original)
+++ Runops-Trace/trunk/t/05printtofh.t Sat May 10 09:44:14 2008
@@ -3,7 +3,7 @@
use strict;
use warnings;
use Runops::Trace;
-BEGIN { Runops::Trace::enable() }
+BEGIN { Runops::Trace::enable_tracing() }
use Test::More tests => 1;
Modified: Runops-Trace/trunk/t/06counters.t
==============================================================================
--- Runops-Trace/trunk/t/06counters.t (original)
+++ Runops-Trace/trunk/t/06counters.t Sat May 10 09:44:14 2008
@@ -6,22 +6,22 @@
use Runops::Trace;
use Test::More 'no_plan';
-ok( !Runops::Trace::enabled(), "disabled" );
+ok( !Runops::Trace::tracing_enabled(), "disabled" );
-Runops::Trace::set_hook(sub {});
+Runops::Trace::set_tracer(sub {});
is_deeply( Runops::Trace::counters(), {}, "no counters yet" );
-Runops::Trace::enable();
+Runops::Trace::set_trace_threshold(3);
-Runops::Trace::set_threshold(3);
+Runops::Trace::enable_tracing();
my $i;
for ( 1 .. 10 ) {
$i++;
}
-Runops::Trace::disable();
+Runops::Trace::disable_tracing();
is( $i, 10, "loop ran correctly" );
Modified: Runops-Trace/trunk/t/07perl_Hook.t
==============================================================================
--- Runops-Trace/trunk/t/07perl_Hook.t (original)
+++ Runops-Trace/trunk/t/07perl_Hook.t Sat May 10 09:44:14 2008
@@ -10,7 +10,7 @@
my ( $called, @ops, @refgen_args, @aassign_args );
-Runops::Trace::set_hook(sub {
+Runops::Trace::set_tracer(sub {
my ( $op, $arity, @args ) = @_;
$called++;
@@ -30,12 +30,13 @@
sub foo { sub { $i } };
sub bar { sub { $i } };
-Runops::Trace::enable();
+Runops::Trace::enable_tracing();
++$i;
my $j = $i + 42;
-my ( $x, @refs ) = \( 101, [qw/dancing hippies/], 33, \&foo );
+my $y;
+my ( $x, @refs ) = \( $y, [qw/dancing hippies/], 33, \&foo );
$i ? foo() : bar();
@@ -43,7 +44,7 @@
$j = "" . $i;
}
-Runops::Trace::disable();
+Runops::Trace::disable_tracing();
++$i;
Modified: Runops-Trace/trunk/t/08fact.t
==============================================================================
--- Runops-Trace/trunk/t/08fact.t (original)
+++ Runops-Trace/trunk/t/08fact.t Sat May 10 09:44:14 2008
@@ -21,18 +21,18 @@
}
}
-Runops::Trace::set_hook(sub {
- my ( $self, $op, $arity, @args ) = @_;
+Runops::Trace::set_tracer(sub {
+ my ( $op, $arity, @args ) = @_;
#warn "op name: ", $op->name, "($$op) arity: ", $arity, " args: ", \@args;
#use Devel::Peek;
#Dump($_) for @args;
});
-Runops::Trace::enable();
+Runops::Trace::enable_tracing();
my $f = fact(3);
-Runops::Trace::disable();
+Runops::Trace::disable_tracing();
is( $f, 6 );
More information about the Jifty-commit
mailing list