diff options
author | Jim Cromie <jim.cromie@gmail.com> | 2016-04-09 23:20:10 -0600 |
---|---|---|
committer | Tony Cook <tony@develop-help.com> | 2016-06-15 11:52:01 +1000 |
commit | d54523c40e947fbb41347e55dca669b20b9ae52e (patch) | |
tree | 1ae3eab6de96d2d01a891cd5d21d3d17794966c2 /Porting/bench.pl | |
parent | 955a736c2cd1ad6cd7868da807a056c4d540dfaa (diff) | |
download | perl-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-x | Porting/bench.pl | 24 |
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); |