"loading-file" and "loaded-file" DTrace probes

diff --git a/mydtrace.h b/mydtrace.h
index 8ee130f..951d177 100644 (file)
--- a/mydtrace.h
+++ b/mydtrace.h
@@ -38,6 +38,18 @@
        PERL_OP_ENTRY(tmp_name, file, line, stash);     \
     }
 
+#    define LOADING_FILE_PROBE(name)                           \
+    if (PERL_LOADING_FILE_ENABLED()) {                         \
+       const char *tmp_name = name;                    \
+       PERL_LOADING_FILE(tmp_name);                            \
+    }
+
+#    define LOADED_FILE_PROBE(name)                            \
+    if (PERL_LOADED_FILE_ENABLED()) {                          \
+       const char *tmp_name = name;                    \
+       PERL_LOADED_FILE(tmp_name);                             \
+    }
+
 #  else
 
 #    define ENTRY_PROBE(func, file, line, stash)       \
@@ -55,6 +67,16 @@
        PERL_OP_ENTRY(name);                            \
     }
 
+#    define LOADING_FILE_PROBE(name)                           \
+    if (PERL_LOADING_FILE_ENABLED()) {                         \
+       PERL_LOADING_FILE(name);                                        \
+    }
+
+#    define LOADED_FILE_PROBE(name)                            \
+    if (PERL_LOADED_FILE_ENABLED()) {                          \
+       PERL_LOADED_FILE(name);                                         \
+    }
+
 #  endif
 
 #  define PHASE_CHANGE_PROBE(new_phase, old_phase)      \
@@ -69,6 +91,8 @@
 #  define RETURN_PROBE(func, file, line, stash)
 #  define PHASE_CHANGE_PROBE(new_phase, old_phase)
 #  define OP_ENTRY_PROBE(name)
+#  define LOADING_FILE_PROBE(name)
+#  define LOADED_FILE_PROBE(name)
 
 #endif
 

diff --git a/perldtrace.d b/perldtrace.d
index f352b31..0fdb7ea 100644 (file)
--- a/perldtrace.d
+++ b/perldtrace.d
@@ -10,6 +10,9 @@ provider perl {
     probe phase__change(const char *, const char *);
 
     probe op__entry(const char *);
+
+    probe loading__file(const char *);
+    probe loaded__file(const char *);
 };
 
 /*

diff --git a/pod/perldtrace.pod b/pod/perldtrace.pod
index 60a9370..c5af761 100644 (file)
--- a/pod/perldtrace.pod
+++ b/pod/perldtrace.pod
@@ -57,7 +57,7 @@ The C<phase-change> probe was added.
 
 =item 5.18.0
 
-The C<op-entry> probe was added.
+The C<op-entry>, C<loading-file>, and C<loaded-file> probes weree added.
 
 =back
 
@@ -112,6 +112,29 @@ still before the opcode itself is executed).
         printf("About to execute opcode %s\n", copyinstr(arg0));
     }
 
+=item loading-file(FILENAME)
+
+Fires when Perl is about to load an individual file, whether from
+C<use>, C<require>, or C<do>. This probe fires before the file is
+read from disk. The filename argument is converted to local filesystem
+paths instead of providing C<Module::Name>-style names.
+
+    :*perl*:loading-file {
+        printf("About to load %s\n", copyinstr(arg0));
+    }
+
+=item loaded-file(FILENAME)
+
+Fires when Perl has successfully loaded an individual file, whether
+from C<use>, C<require>, or C<do>. This probe fires after the file
+is read from disk and its contentss evaluated. The filename argument
+is converted to local filesystem paths instead of providing
+C<Module::Name>-style names.
+
+    :*perl*:loaded-file {
+        printf("Successfully loaded %s\n", copyinstr(arg0));
+    }
+
 =back
 
 =head1 EXAMPLES
@@ -179,6 +202,8 @@ still before the opcode itself is executed).
     Exporter::Heavy::_rebuild_cache                                5039
     Exporter::import                                              14578
 
+=item 
+
 =back
 
 =head1 REFERENCES

diff --git a/pp_ctl.c b/pp_ctl.c
index b85728b..1477373 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3696,6 +3696,8 @@ PP(pp_require)
        }
     }
 
+    LOADING_FILE_PROBE(unixname);
+
     /* prepare to compile file */
 
     if (path_is_absolute(name)) {
@@ -3998,6 +4000,8 @@ PP(pp_require)
     /* Restore encoding. */
     PL_encoding = encoding;
 
+    LOADED_FILE_PROBE(unixname);
+
     return op;
 }
 

diff --git a/t/run/dtrace.pl b/t/run/dtrace.pl
new file mode 100644 (file)
index 0000000..d81cc07
--- /dev/null
+++ b/t/run/dtrace.pl
@@ -0,0 +1 @@
+42

diff --git a/t/run/dtrace.t b/t/run/dtrace.t
index 183868d..2fa27a3 100644 (file)
--- a/t/run/dtrace.t
+++ b/t/run/dtrace.t
@@ -24,7 +24,7 @@ use strict;
 use warnings;
 use IPC::Open2;
 
-plan(tests => 7);
+plan(tests => 9);
 
 dtrace_like(
     '1',
@@ -132,6 +132,25 @@ D_SCRIPT
     'basic op probe',
 );
 
+dtrace_like(<< 'PERL_SCRIPT',
+    use strict;
+    require HTTP::Tiny;
+    do "run/dtrace.pl";
+PERL_SCRIPT
+    << 'D_SCRIPT',
+    loading-file { printf("loading-file <%s>\n", copyinstr(arg0)) }
+    loaded-file  { printf("loaded-file <%s>\n", copyinstr(arg0)) }
+D_SCRIPT
+    [
+        # the original test made sure that each file generated a loading-file then a loaded-file,
+        # but that had a race condition when the kernel would push the perl process onto a different
+        # CPU, so the DTrace output would appear out of order
+        qr{loading-file <strict\.pm>.*loading-file <HTTP/Tiny\.pm>.*loading-file <run/dtrace\.pl>}s,
+        qr{loaded-file <strict\.pm>.*loaded-file <HTTP/Tiny\.pm>.*loaded-file <run/dtrace\.pl>}s,
+    ],
+    'loading-file, loaded-file probes',
+);
+
 sub dtrace_like {
     my $perl     = shift;
     my $probes   = shift;