summaryrefslogtreecommitdiff
path: root/Porting/bench.pl
diff options
context:
space:
mode:
authorJim Cromie <jim.cromie@gmail.com>2016-04-09 23:20:10 -0600
committerTony Cook <tony@develop-help.com>2016-06-15 11:52:01 +1000
commitd54523c40e947fbb41347e55dca669b20b9ae52e (patch)
tree1ae3eab6de96d2d01a891cd5d21d3d17794966c2 /Porting/bench.pl
parent955a736c2cd1ad6cd7868da807a056c4d540dfaa (diff)
downloadperl-d54523c40e947fbb41347e55dca669b20b9ae52e.tar.gz
Porting/bench.pl: allow per-PUT (perl under test) options and modules
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.
Diffstat (limited to 'Porting/bench.pl')
-rwxr-xr-xPorting/bench.pl24
1 files changed, 16 insertions, 8 deletions
diff --git a/Porting/bench.pl b/Porting/bench.pl
index c5fddde84b..65536a40ca 100755
--- a/Porting/bench.pl
+++ b/Porting/bench.pl
@@ -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);