diff options
author | Nicholas Clark <nick@ccl4.org> | 2011-09-29 22:44:45 +0200 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2011-09-29 22:44:45 +0200 |
commit | 6a8dbfd7fdd5687ed748747ea8902c967c879870 (patch) | |
tree | 4fead2ea64feaa7dd9144f59d94148e64aa7abcb /Porting/bisect.pl | |
parent | 0061d4fab85ba13ecc6cb1c4657841dbb1b85efb (diff) | |
download | perl-6a8dbfd7fdd5687ed748747ea8902c967c879870.tar.gz |
Add Porting/bisect.pl, to automate bisecting a perl code test case.
Diffstat (limited to 'Porting/bisect.pl')
-rwxr-xr-x | Porting/bisect.pl | 70 |
1 files changed, 70 insertions, 0 deletions
diff --git a/Porting/bisect.pl b/Porting/bisect.pl new file mode 100755 index 0000000000..bc462aa04c --- /dev/null +++ b/Porting/bisect.pl @@ -0,0 +1,70 @@ +#!/usr/bin/perl -w +use strict; + +my $start_time = time; + +use Getopt::Long; + +sub usage { + die "$0: [--start revlike] [--end revlike] [--target=...] [-j=4] [--expect-pass=0|1] thing to test"; +} + +my %options; +unless(GetOptions(\%options, + 'start=s', + 'end=s', + 'target=s', + 'jobs|j=i', + 'expect-pass=i', + 'expect-fail', + 'one-liner|e=s', + )) { + usage(); +} + +my $start = delete $options{start}; +# Currently the earliest version that the runner can build +$start = 'perl-5.005' unless defined $start; +my $end = delete $options{end}; +$end = 'blead' unless defined $end; + +system "git rev-parse $start >/dev/null" and die; +system "git rev-parse $end >/dev/null" and die; + +my $modified = () = `git ls-files --modified --deleted --others`; + +die "This checkout is not clean - $modified modified or untracked file(s)" + if $modified; + +system "git bisect reset" and die; + +my @ARGS; +foreach (sort keys %options) { + push @ARGS, defined $options{$_} ? "--$_=$options{$_}" : "--$_"; +} +push @ARGS, @ARGV; + +my $runner = $0; +$runner =~ s/bisect\.pl/bisect-runner.pl/; + +die "Can't find bisect runner $runner" unless -f $runner; + +# Sanity check the first and last revisions: +system "git checkout $start" and die; +my $ret = system $^X, $runner, @ARGS; +die "Runner returned $ret, not 0 for start revision" if $ret; + +system "git checkout $end" and die; +$ret = system $^X, $runner, @ARGS; +die "Runner returned $ret for end revision" unless $ret; + +system "git bisect start" and die; +system "git bisect good $start" and die; +system "git bisect bad $end" and die; + +# And now get git bisect to do the hard work: +system 'git', 'bisect', 'run', $^X, $runner, @ARGS and die; + +my $end_time = time; + +printf "That took %d seconds\n", $end_time - $start_time; |