MANIFEST typo

[perl5.git] / t / run / dtrace.t

diff --git a/t/run/dtrace.t b/t/run/dtrace.t
index 746f9ae..49bda66 100644 (file)
--- a/t/run/dtrace.t
+++ b/t/run/dtrace.t
@@ -1,7 +1,4 @@
 #!./perl
-use strict;
-use warnings;
-use IPC::Open2;
 
 my $Perl;
 my $dtrace;
@@ -23,7 +20,11 @@ BEGIN {
     $? && skip_all("Apparently can't probe using $dtrace (perhaps you need root?): $result");
 }
 
-plan(tests => 2);
+use strict;
+use warnings;
+use IPC::Open2;
+
+plan(tests => 9);
 
 dtrace_like(
     '1',
@@ -54,6 +55,102 @@ 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/opbasic/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',
+);
+
+dtrace_like(<< 'PERL_SCRIPT',
+    my $tmp = "foo";
+    $tmp =~ s/f/b/;
+    chop $tmp;
+PERL_SCRIPT
+    << 'D_SCRIPT',
+    op-entry { printf("op-entry <%s>\n", copyinstr(arg0)) }
+D_SCRIPT
+    [
+        qr/op-entry <subst>/,
+        qr/op-entry <schop>/,
+    ],
+    '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;
@@ -89,6 +186,11 @@ sub dtrace_like {
     die "Unexpected error from DTrace: $result"
         if $child_exit_status != 0;
 
-    like($result, $expected, $name);
+    if (ref($expected) eq 'ARRAY') {
+        like($result, $_, $name) for @$expected;
+    }
+    else {
+        like($result, $expected, $name);
+    }
 }