[PATCH] New DTrace probe for changes to global phase #11476
Comments
From sartak@gmail.comHi porters, I've recently developed somewhat of a DTrace kick, and I figured what better My first patch does a tiny bit of refactoring to change all those literal: PL_phase = PERL_PHASE_END; assignments to use a new macro instead: PERL_SET_PHASE(PERL_PHASE_END); The second patch, the one with the actual meat in it, adds to that new sudo dtrace -qZn ':perl::phase-change /copyinstr(arg0) == "END"/ { will list all of the function calls made during interpreter cleanup perl -MFile::Temp -MTest::Builder -e 'sub foo {} sub bar {} END { foo } bar' which for me gives: main::foo at -e line 1 Other use cases might be to investigate how many system calls are being made dtrace -qZn ':perl::phase-change /copyinstr(arg0) == "START"/ { produces the top three most-used syscalls for the above Perl one-liner: read 152 Please let me know if there are any reservations about these patches. Keep Cheers, P.S. Is there a leading DTrace expert already on p5p, or did I just |
From sartak@gmail.com0001-Factor-out-a-PERL_SET_PHASE-macro.patchFrom 58a06746c9bbfd7ecad49c2f77fffc93c253f14c Mon Sep 17 00:00:00 2001
From: Shawn M Moore <sartak@bestpractical.com>
Date: Wed, 6 Jul 2011 22:34:49 -0400
Subject: [PATCH 1/2] Factor out a PERL_SET_PHASE macro
This is the first step in adding a dtrace probe for global phase change
---
perl.c | 16 ++++++++--------
perl.h | 5 +++++
2 files changed, 13 insertions(+), 8 deletions(-)
diff --git a/perl.c b/perl.c
index e345ae1..914fbcd 100644
--- a/perl.c
+++ b/perl.c
@@ -562,7 +562,7 @@ perl_destruct(pTHXx)
JMPENV_PUSH(x);
PERL_UNUSED_VAR(x);
if (PL_endav && !PL_minus_c) {
- PL_phase = PERL_PHASE_END;
+ PERL_SET_PHASE(PERL_PHASE_END);
call_list(PL_scopestack_ix, PL_endav);
}
JMPENV_POP;
@@ -757,7 +757,7 @@ perl_destruct(pTHXx)
* destruct_level > 0 */
SvREFCNT_dec(PL_main_cv);
PL_main_cv = NULL;
- PL_phase = PERL_PHASE_DESTRUCT;
+ PERL_SET_PHASE(PERL_PHASE_DESTRUCT);
/* Tell PerlIO we are about to tear things apart in case
we have layers which are using resources that should
@@ -1607,7 +1607,7 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)
call_list(oldscope, PL_unitcheckav);
}
if (PL_checkav) {
- PL_phase = PERL_PHASE_CHECK;
+ PERL_SET_PHASE(PERL_PHASE_CHECK);
call_list(oldscope, PL_checkav);
}
ret = 0;
@@ -1625,7 +1625,7 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)
call_list(oldscope, PL_unitcheckav);
}
if (PL_checkav) {
- PL_phase = PERL_PHASE_CHECK;
+ PERL_SET_PHASE(PERL_PHASE_CHECK);
call_list(oldscope, PL_checkav);
}
ret = STATUS_EXIT;
@@ -1774,7 +1774,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
SV *linestr_sv = newSV_type(SVt_PVIV);
bool add_read_e_script = FALSE;
- PL_phase = PERL_PHASE_START;
+ PERL_SET_PHASE(PERL_PHASE_START);
SvGROW(linestr_sv, 80);
sv_setpvs(linestr_sv,"");
@@ -2278,7 +2278,7 @@ perl_run(pTHXx)
PL_curstash = PL_defstash;
if (!(PL_exit_flags & PERL_EXIT_DESTRUCT_END) &&
PL_endav && !PL_minus_c) {
- PL_phase = PERL_PHASE_END;
+ PERL_SET_PHASE(PERL_PHASE_END);
call_list(oldscope, PL_endav);
}
#ifdef MYMALLOC
@@ -2330,7 +2330,7 @@ S_run_body(pTHX_ I32 oldscope)
if (PERLDB_SINGLE && PL_DBsingle)
sv_setiv(PL_DBsingle, 1);
if (PL_initav) {
- PL_phase = PERL_PHASE_INIT;
+ PERL_SET_PHASE(PERL_PHASE_INIT);
call_list(oldscope, PL_initav);
}
#ifdef PERL_DEBUG_READONLY_OPS
@@ -2340,7 +2340,7 @@ S_run_body(pTHX_ I32 oldscope)
/* do it */
- PL_phase = PERL_PHASE_RUN;
+ PERL_SET_PHASE(PERL_PHASE_RUN);
if (PL_restartop) {
PL_restartjmpenv = NULL;
diff --git a/perl.h b/perl.h
index 6e1038b..423d264 100644
--- a/perl.h
+++ b/perl.h
@@ -4718,6 +4718,11 @@ EXTCONST char PL_bincompat_options[] =
EXTCONST char PL_bincompat_options[];
#endif
+#ifndef PERL_SET_PHASE
+# define PERL_SET_PHASE(new_phase) \
+ PL_phase = new_phase;
+#endif
+
/* The interpreter phases. If these ever change, PL_phase_names right below will
* need to be updated accordingly. */
enum perl_phase {
--
1.7.5.1
|
From sartak@gmail.com0002-Add-a-phase-change-DTrace-probe.patchFrom b27b5d665c1bc8d61e6c24e91ed57f934d6e5c16 Mon Sep 17 00:00:00 2001
From: Shawn M Moore <sartak@bestpractical.com>
Date: Wed, 6 Jul 2011 22:35:47 -0400
Subject: [PATCH 2/2] Add a phase-change DTrace probe
---
mydtrace.h | 6 ++++++
perl.h | 1 +
perldtrace.d | 2 ++
3 files changed, 9 insertions(+), 0 deletions(-)
diff --git a/mydtrace.h b/mydtrace.h
index 75e6918..a7a4e47 100644
--- a/mydtrace.h
+++ b/mydtrace.h
@@ -23,11 +23,17 @@
PERL_SUB_RETURN(func, file, line, stash); \
}
+# define PHASE_CHANGE_PROBE(new_phase, old_phase) \
+ if (PERL_PHASE_CHANGE_ENABLED()) { \
+ PERL_PHASE_CHANGE(new_phase, old_phase); \
+ }
+
#else
/* NOPs */
# define ENTRY_PROBE(func, file, line, stash)
# define RETURN_PROBE(func, file, line, stash)
+# define PHASE_CHANGE_PROBE(new_phase, old_phase)
#endif
diff --git a/perl.h b/perl.h
index 423d264..4d20047 100644
--- a/perl.h
+++ b/perl.h
@@ -4720,6 +4720,7 @@ EXTCONST char PL_bincompat_options[];
#ifndef PERL_SET_PHASE
# define PERL_SET_PHASE(new_phase) \
+ PHASE_CHANGE_PROBE(PL_phase_names[new_phase], PL_phase_names[PL_phase]); \
PL_phase = new_phase;
#endif
diff --git a/perldtrace.d b/perldtrace.d
index 5175f24..6040d2b 100644
--- a/perldtrace.d
+++ b/perldtrace.d
@@ -6,6 +6,8 @@
provider perl {
probe sub__entry(char *, char *, int, char *);
probe sub__return(char *, char *, int, char *);
+
+ probe phase__change(const char *, const char *);
};
/*
--
1.7.5.1
|
From @cpansproutOn Wed Jul 06 20:58:57 2011, sartak wrote:
I think you did. :-) We now have a nuncupative policy that new feature have to be accompanied Where is this DTrace stuff documented, anyway? |
|
The RT System itself - Status changed from 'new' to 'open' |
From sartak@gmail.comI've tried my hand at writing a DTrace test file. Anything I can do to Shawn |
From sartak@gmail.com0001-New-test-file-that-exercises-Perl-s-DTrace-support.patchFrom b33eaa99148fb91ae9c36e24856e3f0f467f7749 Mon Sep 17 00:00:00 2001
From: Shawn M Moore <sartak@gmail.com>
Date: Mon, 11 Jul 2011 16:24:07 -0400
Subject: [PATCH] New test file that exercises Perl's DTrace support
---
t/run/dtrace.t | 96 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 files changed, 96 insertions(+), 0 deletions(-)
create mode 100644 t/run/dtrace.t
diff --git a/t/run/dtrace.t b/t/run/dtrace.t
new file mode 100644
index 0000000..19aa2f5
--- /dev/null
+++ b/t/run/dtrace.t
@@ -0,0 +1,96 @@
+#!./perl
+use strict;
+use warnings;
+use IPC::Open2;
+
+my $Perl;
+my $dtrace;
+
+BEGIN {
+ chdir 't';
+ @INC = '../lib';
+ require './test.pl';
+
+ skip_all_without_config("usedtrace");
+
+ $dtrace = -x '/usr/sbin/dtrace' ? '/usr/sbin/dtrace'
+ : -x '/usr/bin/dtrace' ? '/usr/bin/dtrace'
+ : 'dtrace';
+
+ $Perl = which_perl();
+
+ `$dtrace -V` or skip_all("dtrace unavailable");
+
+ my $result = `$dtrace -qnBEGIN -c'$Perl -e 1' 2>&1`;
+ $? && skip_all("Apparently can't $dtrace (perhaps you need root?): $result");
+}
+
+plan(tests => 2);
+
+dtrace_like(
+ '1',
+ 'BEGIN { trace(42+666) }',
+ qr/708/,
+ 'really running DTrace',
+);
+
+dtrace_like(
+ 'package My;
+ sub outer { Your::inner() }
+ package Your;
+ sub inner { }
+ package Other;
+ My::outer();
+ Your::inner();',
+
+ 'sub-entry { printf("-> %s::%s at %s line %d!\n", copyinstr(arg3), copyinstr(arg0), copyinstr(arg1), arg2) }
+ sub-return { printf("<- %s::%s at %s line %d!\n", copyinstr(arg3), copyinstr(arg0), copyinstr(arg1), arg2) }',
+
+ qr/-> My::outer at - line 2!
+-> Your::inner at - line 4!
+<- Your::inner at - line 4!
+<- My::outer at - line 2!
+-> Your::inner at - line 4!
+<- Your::inner at - line 4!/,
+
+ 'traced multiple function calls',
+);
+
+sub dtrace_like {
+ my $perl = shift;
+ my $probes = shift;
+ my $expected = shift;
+ my $name = shift;
+
+ my ($reader, $writer);
+
+ my $pid = open2($reader, $writer,
+ $dtrace,
+ '-q',
+ '-n', 'BEGIN { trace("ready!\n") }', # necessary! see below
+ '-n', $probes,
+ '-c', $Perl,
+ );
+
+ # wait until DTrace tells us that it is initialized
+ # otherwise our probes won't properly fire
+ chomp(my $throwaway = <$reader>);
+ $throwaway eq "ready!" or die "Unexpected 'ready!' result from DTrace: $throwaway";
+
+ # now we can start executing our perl
+ print $writer $perl;
+ close $writer;
+
+ # read all the dtrace results back in
+ local $/;
+ my $result = <$reader>;
+
+ # make sure that dtrace is all done and successful
+ waitpid($pid, 0);
+ my $child_exit_status = $? >> 8;
+ die "Unexpected error from DTrace: $result"
+ if $child_exit_status != 0;
+
+ like($result, $expected, $name);
+}
+
--
1.7.5.1
|
From sartak@gmail.com2011/7/10 Father Chrysostomos via RT <perlbug-followup@perl.org>
I plan to write a perldtrace document that walks through all the probes Perl I'm also providing a slightly updated test file patch which now respects Shawn |
From sartak@gmail.com0001-New-test-file-that-exercises-Perl-s-DTrace-support.patchFrom 189553285f2c3db77602ef4e1863fa98fede9e1f Mon Sep 17 00:00:00 2001
From: Shawn M Moore <sartak@gmail.com>
Date: Mon, 11 Jul 2011 16:24:07 -0400
Subject: [PATCH] New test file that exercises Perl's DTrace support
---
t/run/dtrace.t | 94 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 files changed, 94 insertions(+), 0 deletions(-)
create mode 100644 t/run/dtrace.t
diff --git a/t/run/dtrace.t b/t/run/dtrace.t
new file mode 100644
index 0000000..ae253fa
--- /dev/null
+++ b/t/run/dtrace.t
@@ -0,0 +1,94 @@
+#!./perl
+use strict;
+use warnings;
+use IPC::Open2;
+
+my $Perl;
+my $dtrace;
+
+BEGIN {
+ chdir 't';
+ @INC = '../lib';
+ require './test.pl';
+
+ skip_all_without_config("usedtrace");
+
+ $dtrace = $Config{dtrace};
+
+ $Perl = which_perl();
+
+ `$dtrace -V` or skip_all("$dtrace unavailable");
+
+ my $result = `$dtrace -qnBEGIN -c'$Perl -e 1' 2>&1`;
+ $? && skip_all("Apparently can't probe using $dtrace (perhaps you need root?): $result");
+}
+
+plan(tests => 2);
+
+dtrace_like(
+ '1',
+ 'BEGIN { trace(42+666) }',
+ qr/708/,
+ 'really running DTrace',
+);
+
+dtrace_like(
+ 'package My;
+ sub outer { Your::inner() }
+ package Your;
+ sub inner { }
+ package Other;
+ My::outer();
+ Your::inner();',
+
+ 'sub-entry { printf("-> %s::%s at %s line %d!\n", copyinstr(arg3), copyinstr(arg0), copyinstr(arg1), arg2) }
+ sub-return { printf("<- %s::%s at %s line %d!\n", copyinstr(arg3), copyinstr(arg0), copyinstr(arg1), arg2) }',
+
+ qr/-> My::outer at - line 2!
+-> Your::inner at - line 4!
+<- Your::inner at - line 4!
+<- My::outer at - line 2!
+-> Your::inner at - line 4!
+<- Your::inner at - line 4!/,
+
+ 'traced multiple function calls',
+);
+
+sub dtrace_like {
+ my $perl = shift;
+ my $probes = shift;
+ my $expected = shift;
+ my $name = shift;
+
+ my ($reader, $writer);
+
+ my $pid = open2($reader, $writer,
+ $dtrace,
+ '-q',
+ '-n', 'BEGIN { trace("ready!\n") }', # necessary! see below
+ '-n', $probes,
+ '-c', $Perl,
+ );
+
+ # wait until DTrace tells us that it is initialized
+ # otherwise our probes won't properly fire
+ chomp(my $throwaway = <$reader>);
+ $throwaway eq "ready!" or die "Unexpected 'ready!' result from DTrace: $throwaway";
+
+ # now we can start executing our perl
+ print $writer $perl;
+ close $writer;
+
+ # read all the dtrace results back in
+ local $/;
+ my $result = <$reader>;
+
+ # make sure that dtrace is all done and successful
+ waitpid($pid, 0);
+ my $child_exit_status = $? >> 8;
+ die "Unexpected error from DTrace: $result"
+ if $child_exit_status != 0;
+
+ like($result, $expected, $name);
+}
+
--
1.7.5.1
|
From sartak@gmail.com2011/7/11 Sartak <sartak@gmail.com>
And so I did! See attached. :) Once this patch and my test patch make it to Shawn |
From sartak@gmail.com0001-New-document-for-perldtrace.patchFrom ef819fab43468ae30ad119485fd4776f16684290 Mon Sep 17 00:00:00 2001
From: Shawn M Moore <sartak@gmail.com>
Date: Mon, 11 Jul 2011 20:49:25 -0400
Subject: [PATCH] New document for perldtrace
---
pod/perldtrace.pod | 144 ++++++++++++++++++++++++++++++++++++++++++++++++++++
1 files changed, 144 insertions(+), 0 deletions(-)
create mode 100644 pod/perldtrace.pod
diff --git a/pod/perldtrace.pod b/pod/perldtrace.pod
new file mode 100644
index 0000000..2654417
--- /dev/null
+++ b/pod/perldtrace.pod
@@ -0,0 +1,144 @@
+=head1 NAME
+
+perldtrace - Perl's support for DTrace
+
+=head1 SYNOPSIS
+
+ # dtrace -Zn 'perl::sub-entry, perl::sub-return { trace(copyinstr(arg0)) }'
+ dtrace: description 'perl::sub-entry, perl::sub-return ' matched 10 probes
+
+ # perl -E 'sub outer { inner(@_) } sub inner { say shift } outer("hello")'
+ hello
+
+ (dtrace output)
+ CPU ID FUNCTION:NAME
+ 0 75915 Perl_pp_entersub:sub-entry BEGIN
+ 0 75915 Perl_pp_entersub:sub-entry import
+ 0 75922 Perl_pp_leavesub:sub-return import
+ 0 75922 Perl_pp_leavesub:sub-return BEGIN
+ 0 75915 Perl_pp_entersub:sub-entry outer
+ 0 75915 Perl_pp_entersub:sub-entry inner
+ 0 75922 Perl_pp_leavesub:sub-return inner
+ 0 75922 Perl_pp_leavesub:sub-return outer
+
+=head1 DESCRIPTION
+
+DTrace is a framework for comprehensive system- and application-level
+tracing. Perl is a DTrace I<provider>, meaning it exposes several
+I<probes> for instrumentation. You can use these in conjunction
+with kernel-level probes, as well as probes from other providers
+such as MySQL, in order to diagnose software defects, or even just
+your application's bottlenecks.
+
+Perl must be compiled with the C<-Dusedtrace> option in order to
+make use of the provided probes. While DTrace aims to have no
+overhead when its instrumentation is not active, Perl's support
+itself cannot uphold that guarantee, so it is built without DTrace
+probes under most systems. One notable exception is that Mac OS X
+ships a F</usr/bin/perl> with DTrace support enabled.
+
+=head1 HISTORY
+
+=over 4
+
+=item 5.10.1
+
+Perl's initial DTrace support was added, providing C<sub-entry> and
+C<sub-return> probes.
+
+=item 5.14.0
+
+The C<sub-entry> and C<sub-return> probes gain a fourth argument: the
+package name of the function.
+
+=back
+
+=head1 PROBES
+
+=over 4
+
+=item sub-entry(SUBNAME, FILE, LINE, PACKAGE)
+
+Traces the entry of any subroutine. Note that all of the variables
+refer to the subroutine that is being invoked; there is currently
+no way to get ahold of any information about the subroutine's
+I<caller> from a DTrace action.
+
+ :*perl*::sub-entry {
+ printf("%s::%s entered at %s line %d\n",
+ copyinstr(arg3), copyinstr(arg0), copyinstr(arg1), arg0);
+ }
+
+=item sub-return(SUBNAME, FILE, LINE, PACKAGE)
+
+Traces the exit of any subroutine. Note that all of the variables
+refer to the subroutine that is returning; there is currently no
+way to get ahold of any information about the subroutine's I<caller>
+from a DTrace action.
+
+ :*perl*::sub-return {
+ printf("%s::%s returned at %s line %d\n",
+ copyinstr(arg3), copyinstr(arg0), copyinstr(arg1), arg0);
+ }
+
+=back
+
+=head1 EXAMPLES
+
+=over 4
+
+=item Most frequently called functions
+
+ # dtrace -qZn 'sub-entry { @[strjoin(strjoin(copyinstr(arg3),"::"),copyinstr(arg0))] = count() } END {trunc(@, 10)}'
+
+ Class::MOP::Attribute::slots 400
+ Try::Tiny::catch 411
+ Try::Tiny::try 411
+ Class::MOP::Instance::inline_slot_access 451
+ Class::MOP::Class::Immutable::Trait:::around 472
+ Class::MOP::Mixin::AttributeCore::has_initializer 496
+ Class::MOP::Method::Wrapped::__ANON__ 544
+ Class::MOP::Package::_package_stash 737
+ Class::MOP::Class::initialize 1128
+ Class::MOP::get_metaclass_by_name 1204
+
+=item Trace function calls
+
+ # dtrace -qFZn 'sub-entry, sub-return { trace(copyinstr(arg0)) }'
+
+ 0 -> Perl_pp_entersub BEGIN
+ 0 <- Perl_pp_leavesub BEGIN
+ 0 -> Perl_pp_entersub BEGIN
+ 0 -> Perl_pp_entersub import
+ 0 <- Perl_pp_leavesub import
+ 0 <- Perl_pp_leavesub BEGIN
+ 0 -> Perl_pp_entersub BEGIN
+ 0 -> Perl_pp_entersub dress
+ 0 <- Perl_pp_leavesub dress
+ 0 -> Perl_pp_entersub dirty
+ 0 <- Perl_pp_leavesub dirty
+ 0 -> Perl_pp_entersub whiten
+ 0 <- Perl_pp_leavesub whiten
+ 0 <- Perl_dounwind BEGIN
+
+=back
+
+=head1 REFERENCES
+
+=over 4
+
+=item DTrace User Guide
+
+L<http://download.oracle.com/docs/cd/E19082-01/819-3620/index.html>
+
+=item DTrace: Dynamic Tracing in Oracle Solaris, Mac OS X and FreeBSD
+
+L<http://www.amazon.com/DTrace-Dynamic-Tracing-Solaris-FreeBSD/dp/0132091518/>
+
+=back
+
+=head1 AUTHORS
+
+Shawn M Moore C<sartak@gmail.com>
+
+=cut
--
1.7.5.1
|
From @cpansproutOn Mon Jul 11 14:50:14 2011, sartak wrote:
The main reason for that policy is to avoid introducing feature without Now I eagerly await your perldtrace.pod! :-) This feels strange. A few years ago I didn’t even know how to use diff,
You did not import %Config, so I changed the test to use |
|
@cpansprout - Status changed from 'open' to 'resolved' |
From @cpansproutOn Mon Jul 11 17:54:53 2011, sartak wrote:
(I should learn to reload the RT page before responding.) OK, now I’m going to apply this patch and run the porting tests.... |
From @cpansproutOn Mon Jul 11 20:41:03 2011, sprout wrote:
Where do you think this be listed in perl.pod? |
From @cpansproutOn Mon Jul 11 20:43:42 2011, sprout wrote:
s/be/should be/; |
From @cpansproutOn Mon Jul 11 20:43:57 2011, sprout wrote:
I’ve just put it in the reference section. I hope that’s OK. Anyway, thank you. I’ve just added your new pod file with commit |
From sartak@gmail.comThanks for cleaning up and applying my patches, Father Chrysostomos. :) I'm reopening this ticket because, like I said, "Once this patch and my test Feels more right to have this final commit be in the same ticket for Thanks again! |
From sartak@gmail.com0001-Document-and-test-the-phase-change-probe.patchFrom e12943d694af10645d45d3b7b1d6ca3fb81c2b73 Mon Sep 17 00:00:00 2001
From: Shawn M Moore <sartak@gmail.com>
Date: Tue, 12 Jul 2011 08:49:10 -0400
Subject: [PATCH] Document and test the phase-change probe
---
pod/perldelta.pod | 19 +++++++++++++--
pod/perldtrace.pod | 63 +++++++++++++++++++++++++++++++++++++++-----------
t/run/dtrace.t | 64 +++++++++++++++++++++++++++++++++++++++++++++++++++-
3 files changed, 128 insertions(+), 18 deletions(-)
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 6306189..b91d66c 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -53,6 +53,14 @@ exhaust memory).
New in Unicode 6.0, this is an improved C<Script> property. Details
are in L<perlunicode/Scripts>.
+=head2 DTrace probes for interpreter phase change
+
+The C<phase-change> probes will fire when the interpreter's phase
+changes, which tracks the C<${^GLOBAL_PHASE}> variable. C<arg0> is
+the new phase name; C<arg1> is the old one. This is useful mostly
+for limiting your instrumentation to one or more of: compile time,
+run time, destruct time.
+
=head1 Security
XXX Any security-related notices go here. In particular, any security
@@ -278,9 +286,10 @@ file and be sure to link to the appropriate page, e.g. L<perlfunc>.
XXX Changes which create B<new> files in F<pod/> go here.
-=head3 L<XXX>
+=head3 L<perldtrace>
-XXX Description of the purpose of the new file here
+L<perldtrace> describes Perl's DTrace support, listing the provided probes
+and gives examples of their use.
=head2 Changes to Existing Documentation
@@ -401,7 +410,11 @@ that they represent may be covered elsewhere.
=item *
-XXX
+F<t/run/dtrace.t> was added to test Perl's DTrace support. This
+test will only be run if your Perl was built with C<-Dusedtrace>
+and if calling C<dtrace> actually lets you instrument code. This
+generally requires being run as root, so this test file is primarily
+intended for use by the dtrace subcommittee of p5p.
=back
diff --git a/pod/perldtrace.pod b/pod/perldtrace.pod
index 2654417..39551e1 100644
--- a/pod/perldtrace.pod
+++ b/pod/perldtrace.pod
@@ -51,6 +51,10 @@ C<sub-return> probes.
The C<sub-entry> and C<sub-return> probes gain a fourth argument: the
package name of the function.
+=item 5.16.0
+
+The C<phase-change> probe was added.
+
=back
=head1 PROBES
@@ -81,6 +85,18 @@ from a DTrace action.
copyinstr(arg3), copyinstr(arg0), copyinstr(arg1), arg0);
}
+=item phase-change(NEWPHASE, OLDPHASE)
+
+Traces changes to Perl's interpreter state. You can internalize this
+as tracing changes to Perl's C<${^GLOBAL_PHASE}> variable, especially
+since the values for C<NEWPHASE> and C<OLDPHASE> are the strings that
+C<${^GLOBAL_PHASE}> reports.
+
+ :*perl*::phase-change {
+ printf("Phase changed from %s to %s\n",
+ copyinstr(arg1), copyinstr(arg0));
+ }
+
=back
=head1 EXAMPLES
@@ -106,20 +122,39 @@ from a DTrace action.
# dtrace -qFZn 'sub-entry, sub-return { trace(copyinstr(arg0)) }'
- 0 -> Perl_pp_entersub BEGIN
- 0 <- Perl_pp_leavesub BEGIN
- 0 -> Perl_pp_entersub BEGIN
- 0 -> Perl_pp_entersub import
- 0 <- Perl_pp_leavesub import
- 0 <- Perl_pp_leavesub BEGIN
- 0 -> Perl_pp_entersub BEGIN
- 0 -> Perl_pp_entersub dress
- 0 <- Perl_pp_leavesub dress
- 0 -> Perl_pp_entersub dirty
- 0 <- Perl_pp_leavesub dirty
- 0 -> Perl_pp_entersub whiten
- 0 <- Perl_pp_leavesub whiten
- 0 <- Perl_dounwind BEGIN
+ 0 -> Perl_pp_entersub BEGIN
+ 0 <- Perl_pp_leavesub BEGIN
+ 0 -> Perl_pp_entersub BEGIN
+ 0 -> Perl_pp_entersub import
+ 0 <- Perl_pp_leavesub import
+ 0 <- Perl_pp_leavesub BEGIN
+ 0 -> Perl_pp_entersub BEGIN
+ 0 -> Perl_pp_entersub dress
+ 0 <- Perl_pp_leavesub dress
+ 0 -> Perl_pp_entersub dirty
+ 0 <- Perl_pp_leavesub dirty
+ 0 -> Perl_pp_entersub whiten
+ 0 <- Perl_pp_leavesub whiten
+ 0 <- Perl_dounwind BEGIN
+
+=item Function calls during interpreter cleanup
+
+ # dtrace -Zn 'phase-change /copyinstr(arg0) == "END"/ { self->ending = 1 } sub-entry /self->ending/ { trace(copyinstr(arg0)) }'
+
+ CPU ID FUNCTION:NAME
+ 1 77214 Perl_pp_entersub:sub-entry END
+ 1 77214 Perl_pp_entersub:sub-entry END
+ 1 77214 Perl_pp_entersub:sub-entry cleanup
+ 1 77214 Perl_pp_entersub:sub-entry _force_writable
+ 1 77214 Perl_pp_entersub:sub-entry _force_writable
+
+=item System calls at compile time
+
+ # dtrace -qZn 'phase-change /copyinstr(arg0) == "START"/ { self->interesting = 1 } phase-change /copyinstr(arg0) == "RUN"/ { self->interesting = 0 } syscall::: /self->interesting/ { @[probefunc] = count() } END { trunc(@, 3) }'
+
+ lseek 310
+ read 374
+ stat64 1056
=back
diff --git a/t/run/dtrace.t b/t/run/dtrace.t
index 4ea851e..625e403 100644
--- a/t/run/dtrace.t
+++ b/t/run/dtrace.t
@@ -24,7 +24,7 @@ use strict;
use warnings;
use IPC::Open2;
-plan(tests => 2);
+plan(tests => 5);
dtrace_like(
'1',
@@ -55,6 +55,68 @@ dtrace_like(
'traced multiple function calls',
);
+dtrace_like(
+ '1',
+ 'phase-change { printf("%s -> %s; ", copyinstr(arg1), copyinstr(arg0)) }',
+ qr/START -> RUN; RUN -> DESTRUCT;/,
+ 'phase changes of a simple script',
+);
+
+# this code taken from t/op/magic_phase.t which tests all of the
+# transitions of ${^GLOBAL_PHASE}. instead of printing (which will
+# interact nondeterministically with the DTrace output), we increment
+# an unused variable for side effects
+dtrace_like(<< 'MAGIC_OP',
+ my $x = 0;
+ BEGIN { $x++ }
+ CHECK { $x++ }
+ INIT { $x++ }
+ sub Moo::DESTROY { $x++ }
+
+ my $tiger = bless {}, Moo::;
+
+ sub Kooh::DESTROY { $x++ }
+
+ our $affe = bless {}, Kooh::;
+
+ END { $x++ }
+MAGIC_OP
+
+ 'phase-change { printf("%s -> %s; ", copyinstr(arg1), copyinstr(arg0)) }',
+
+ qr/START -> CHECK; CHECK -> INIT; INIT -> RUN; RUN -> END; END -> DESTRUCT;/,
+
+ 'phase-changes in a script that exercises all of ${^GLOBAL_PHASE}',
+);
+
+dtrace_like(<< 'PHASES',
+ my $x = 0;
+ sub foo { $x++ }
+ sub bar { $x++ }
+ sub baz { $x++ }
+
+ INIT { foo() }
+ bar();
+ END { baz() }
+PHASES
+
+ '
+ BEGIN { starting = 1 }
+
+ phase-change { phase = arg0 }
+ phase-change /copyinstr(arg0) == "RUN"/ { starting = 0 }
+ phase-change /copyinstr(arg0) == "END"/ { ending = 1 }
+
+ sub-entry /copyinstr(arg0) != copyinstr(phase) && (starting || ending)/ {
+ printf("%s during %s; ", copyinstr(arg0), copyinstr(phase));
+ }
+ ',
+
+ qr/foo during INIT; baz during END;/,
+
+ 'make sure sub-entry and phase-change interact well',
+);
+
sub dtrace_like {
my $perl = shift;
my $probes = shift;
--
1.7.5.1
|
|
sartak@gmail.com - Status changed from 'resolved' to 'open' |
From @cpansproutOn Tue Jul 12 06:09:19 2011, sartak wrote:
Thank you. Applied as 2b67939. |
|
@cpansprout - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#94234 (status was 'resolved')
Searchable as RT94234$
The text was updated successfully, but these errors were encountered: