This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Porting/bench.pl: allow per-PUT (perl under test) options and modules
authorJim Cromie <jim.cromie@gmail.com>
Sun, 10 Apr 2016 05:20:10 +0000 (23:20 -0600)
committerTony Cook <tony@develop-help.com>
Wed, 15 Jun 2016 01:52:01 +0000 (11:52 +1000)
Rework process_perls() to give a richer usage / API, allowing
additional command-line options, specific to each Perl-Under-Test.
For example:

  bench.pl -- perl=plain perl=slower -Mstrict -DmpMA

The above runs the same perl-exe for 2 different tests (PUTS), but
adds expensive debugging options to only the 2nd PUT.

Do this by changing strategy; we scan the list backwards, and
test/treat each item as a perlexe (ie qx/$perlexe -e 'print "ok"/).
Instead of dieing on a not-perl, they're collected and submitted as a
PUT once a $perlexe is found.

Added 'require_order' to terminate arg processing when '--' is
encountered on cmdline; without it the PUT options are in-validated by
GetOptions.

Porting/bench.pl

index c5fddde..65536a4 100755 (executable)
@@ -209,7 +209,7 @@ Requires C<JSON::PP> to be available.
 use 5.010000;
 use warnings;
 use strict;
-use Getopt::Long qw(:config no_auto_abbrev);
+use Getopt::Long qw(:config no_auto_abbrev require_order);
 use IPC::Open2 ();
 use IO::Select;
 use IO::File;
@@ -227,7 +227,7 @@ my %VALID_FIELDS = map { $_ => 1 }
 
 sub usage {
     die <<EOF;
-usage: $0 [options] perl[=label] ...
+usage: $0 [options] -- perl[=label] ...
   --action=foo       What action to perform [default: grind].
   --average          Only display average, not individual test results.
   --benchfile=foo    File containing the benchmarks;
@@ -480,19 +480,27 @@ sub select_a_perl {
 # Validate the list of perl=label on the command line.
 # Return a list of [ exe, label ] pairs.
 
-sub process_perls {
+sub process_puts {
     my @results;
     my %seen;
-    for my $p (@_) {
+    my @putargs; # collect not-perls into args per PUT
+
+    for my $p (reverse @_) {
+        push @putargs, $p and next if $p =~ /^-/; # not-perl, dont send to qx//
+
         my ($perl, $label) = split /=/, $p, 2;
         $label //= $perl;
         die "$label cannot be used on 2 different PUTs\n" if $seen{$label}++;
 
         my $r = qx($perl -e 'print qq(ok\n)' 2>&1);
-        die "Error: unable to execute '$perl': $r" if $r ne "ok\n";
-        push @results, [ $perl, $label ];
+        if ($r eq "ok\n") {
+           push @results, [ $perl, $label, reverse @putargs ];
+            @putargs = ();
+       } else {
+            push @putargs, $p; # not-perl
+       }
     }
-    return @results;
+    return reverse @results;
 }
 
 
@@ -620,7 +628,7 @@ sub do_grind {
         die "Error: only a single test may be specified with --bisect\n"
             if defined $OPTS{bisect} and keys %$tests != 1;
 
-        $perls = [ process_perls(@$perl_args) ];
+        $perls = [ process_puts(@$perl_args) ];
 
 
         $results = grind_run($tests, $order, $perls, $loop_counts);