This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
bench.pl: add 'compile' benchmark field
authorDavid Mitchell <davem@iabyn.com>
Mon, 23 Oct 2017 10:29:18 +0000 (11:29 +0100)
committerDavid Mitchell <davem@iabyn.com>
Mon, 23 Oct 2017 10:52:03 +0000 (11:52 +0100)
If a benchmark has this flag set, measure the compile time of the
construct rather than its execution time, by wrapping the code in

    eval q{ sub { ... } }

Porting/bench.pl
t/perf/benchmarks

index 303eee4..e87c290 100755 (executable)
@@ -619,7 +619,7 @@ sub read_tests_file {
     # validate and process each test
 
     {
     # validate and process each test
 
     {
-        my %valid = map { $_ => 1 } qw(desc setup code pre post);
+        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";
         my @tests = @$ta;
         if (!@tests || @tests % 2 != 0) {
             die "Error: '$file' does not contain evenly paired test names and hashes\n";
@@ -855,24 +855,33 @@ sub process_executables_list {
 #   {1;}    => nextstate;                       unstack
 #   {$x=1;} => nextstate; const; gvsv; sassign; unstack
 # Note also that each statement is prefixed with a label; this avoids
 #   {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
+# 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 ($name, $test, $body) = @_;
 
 sub make_perl_prog {
     my ($name, $test, $body) = @_;
-    my ($desc, $setup, $code, $pre, $post) =
-                                    @$test{qw(desc setup code pre post)};
+    my ($desc, $setup, $code, $pre, $post, $compile) =
+                                @$test{qw(desc setup code pre post compile)};
 
     $pre  = defined $pre  ? "_PRE_: $pre; " : "";
     $post = defined $post ? "_POST_: $post; " : "";
     $code = $body ? $code : "1";
     $code = "_CODE_: $code; ";
 
     $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 $name;
 BEGIN { srand(0) }
 $setup;
 for my \$__loop__ (1..\$ARGV[0]) {
     return <<EOF;
 # $desc
 package $name;
 BEGIN { srand(0) }
 $setup;
 for my \$__loop__ (1..\$ARGV[0]) {
-    $pre$code$post
+    $full
 }
 EOF
 }
 }
 EOF
 }
index f366d4b..423230a 100644 (file)
 #     pre  => '$x  = ""',
 #     code => '$x .= "foo"',
 #
 #     pre  => '$x  = ""',
 #     code => '$x .= "foo"',
 #
+# Finally, the optional 'compile' key causes the code body to be wrapped
+# in eval qw{ sub { ... }}, so that compile time rather than execution
+# time is measured.
 
 
 [
 
 
 [