Update IO-Compress to CPAN version 2.093

[perl5.git] / Porting / bench.pl

diff --git a/Porting/bench.pl b/Porting/bench.pl
index 9866f8a..6087dca 100755 (executable)
--- a/Porting/bench.pl
+++ b/Porting/bench.pl
@@ -619,7 +619,7 @@ sub read_tests_file {
     # validate and process each test
 
     {
-        my %valid = map { $_ => 1 } qw(desc setup code);
+        my %valid = map { $_ => 1 } qw(desc setup code pre post compile);
         my @tests = @$ta;
         if (!@tests || @tests % 2 != 0) {
             die "Error: '$file' does not contain evenly paired test names and hashes\n";
@@ -846,19 +846,43 @@ sub process_executables_list {
 
 
 
-# Return a string containing perl test code wrapped in a loop
-# that runs $ARGV[0] times
+# Return a string containing a perl program which runs the benchmark code
+# $ARGV[0] times. If $body is true, include the main body (setup) in
+# the loop; otherwise create an empty loop with just pre and post.
+# Note that an empty body is handled with '1;' so that a completely empty
+# loop has a single nextstate rather than a stub op, so more closely
+# matches the active loop; e.g.:
+#   {1;}    => nextstate;                       unstack
+#   {$x=1;} => nextstate; const; gvsv; sassign; unstack
+# Note also that each statement is prefixed with a label; this avoids
+# adjacent nextstate ops being optimised away.
+#
+# A final 1; statement is added so that the code is always in void
+# context.
+#
+# It the compile flag is set for a test, the body of the loop is wrapped in
+# eval 'sub { .... }' to measure compile time rather than execution time
 
 sub make_perl_prog {
-    my ($test, $desc, $setup, $code) = @_;
+    my ($name, $test, $body) = @_;
+    my ($desc, $setup, $code, $pre, $post, $compile) =
+                                @$test{qw(desc setup code pre post compile)};
+
+    $setup //= '';
+    $pre  = defined $pre  ? "_PRE_: $pre; " : "";
+    $post = defined $post ? "_POST_: $post; " : "";
+    $code = $body ? $code : "1";
+    $code = "_CODE_: $code; ";
+    my $full = "$pre$code$post _CXT_: 1; ";
+    $full = "eval q{sub { $full }};" if $compile;
 
     return <<EOF;
 # $desc
-package $test;
+package $name;
 BEGIN { srand(0) }
 $setup;
 for my \$__loop__ (1..\$ARGV[0]) {
-    $code;
+    $full
 }
 EOF
 }
@@ -1143,14 +1167,9 @@ sub grind_run {
     for my $test (grep $tests->{$_}, @$order) {
 
         # Create two test progs: one with an empty loop and one with code.
-        # Note that the empty loop is actually '{1;}' rather than '{}';
-        # this causes the loop to have a single nextstate rather than a
-        # stub op, so more closely matches the active loop; e.g.:
-        #   {1;}    => nextstate;                       unstack
-        #   {$x=1;} => nextstate; const; gvsv; sassign; unstack
         my @prog = (
-            make_perl_prog($test, @{$tests->{$test}}{qw(desc setup)}, '1'),
-            make_perl_prog($test, @{$tests->{$test}}{qw(desc setup code)}),
+            make_perl_prog($test, $tests->{$test}, 0),
+            make_perl_prog($test, $tests->{$test}, 1),
         );
 
         for my $p (@$perls) {