=cut
-my $start_time = time;
-
# The default, auto_abbrev will treat -e as an abbreviation of --end
# Which isn't what we want.
use Getopt::Long qw(:config pass_through no_auto_abbrev);
-my ($start, $end, $validate);
-unshift @ARGV, '--help' unless GetOptions('start=s' => \$start,
- 'end=s' => \$end,
- validate => \$validate);
+my ($start, $end, $validate, $usage, $bad, $jobs, $make, $gold);
+$bad = !GetOptions('start=s' => \$start, 'end=s' => \$end,
+ 'jobs|j=i' => \$jobs, 'make=s' => \$make, 'gold=s' => \$gold,
+ validate => \$validate, 'usage|help|?' => \$usage);
+unshift @ARGV, '--help' if $bad || $usage;
unshift @ARGV, '--validate' if $validate;
my $runner = $0;
die "Can't find bisect runner $runner" unless -f $runner;
-{
- my ($dev0, $ino0) = stat $0;
- die "Can't stat $0: $!" unless defined $ino0;
- my ($dev1, $ino1) = stat 'Porting/bisect.pl';
- die "Can't run a bisect using the directory containing $runner"
- if defined $dev1 && $dev0 == $dev1 && $ino0 == $ino1;
+system $^X, $runner, '--check-args', '--check-shebang', @ARGV and exit 255;
+exit 255 if $bad;
+exit 0 if $usage;
+
+my $start_time = time;
+
+if (!defined $jobs &&
+ !($^O eq 'hpux' && system((defined $make ? $make : 'make')
+ . ' --version >/dev/null 2>&1'))) {
+ # Try to default to (ab)use all the CPUs:
+ my $cpus;
+ if (open my $fh, '<', '/proc/cpuinfo') {
+ while (<$fh>) {
+ ++$cpus if /^processor\s+:\s+\d+$/;
+ }
+ } elsif (-x '/sbin/sysctl') {
+ $cpus = $1 if `/sbin/sysctl hw.ncpu` =~ /^hw\.ncpu: (\d+)$/;
+ } elsif (-x '/usr/bin/getconf') {
+ $cpus = $1 if `/usr/bin/getconf _NPROCESSORS_ONLN` =~ /^(\d+)$/;
+ }
+ $jobs = defined $cpus ? $cpus + 1 : 2;
}
-system $^X, $runner, '--check-args', '--check-shebang', @ARGV and exit 255;
+unshift @ARGV, '--jobs', $jobs if defined $jobs;
+unshift @ARGV, '--make', $make if defined $make;
# We try these in this order for the start revision if none is specified.
-my @stable = qw(perl-5.002 perl-5.003 perl-5.004 perl-5.005 perl-5.6.0
- perl-5.8.0 v5.10.0 v5.12.0 v5.14.0);
+my @stable = map {chomp $_; $_} grep {/v5\.[0-9]+[02468]\.0$/} `git tag -l`;
+die "git tag -l didn't seem to return any tags for stable releases"
+ unless @stable;
+unshift @stable, qw(perl-5.005 perl-5.6.0 perl-5.8.0);
+
+{
+ my ($dev_C, $ino_C) = stat 'Configure';
+ my ($dev_c, $ino_c) = stat 'configure';
+ if (defined $dev_C && defined $dev_c
+ && $dev_C == $dev_c && $ino_C == $ino_c) {
+ print "You seem to be on a case-insensitive file system.\n\n";
+ } else {
+ unshift @stable, qw(perl-5.002 perl-5.003 perl-5.004)
+ }
+}
-$end = 'blead' unless defined $end;
+unshift @ARGV, '--gold', defined $gold ? $gold : $stable[-1];
+
+if (!defined $end) {
+ # If we have a branch blead, use that as the end
+ $end = `git rev-parse --verify --quiet blead`;
+ die unless defined $end;
+ if (!length $end) {
+ # Else use whichever is newer - HEAD, or the most recent stable tag.
+ if (`git rev-list -n1 HEAD ^$stable[-1]` eq "") {
+ $end = pop @stable;
+ } else {
+ $end = 'HEAD';
+ }
+ }
+}
# Canonicalising branches to revisions before moving the checkout permits one
# to use revisions such as 'HEAD' for --start or --end
chomp;
}
-my $modified = () = `git ls-files --modified --deleted --others`;
+{
+ my $modified = my @modified = `git ls-files --modified --deleted --others`;
+
+ my ($dev0, $ino0) = stat $0;
+ die "Can't stat $0: $!" unless defined $ino0;
+ my ($dev1, $ino1) = stat 'Porting/bisect.pl';
+
+ my $inplace = defined $dev1 && $dev0 == $dev1 && $ino0 == $ino1;
+
+ if ($modified) {
+ my $final = $inplace
+ ? "Can't run a bisect using a dirty directory containing $runner"
+ : "You can use 'git clean -Xdf' to cleanup the ignored files";
+
+ die "This checkout is not clean, found file(s):\n",
+ join("\t","",@modified),
+ "$modified modified, untracked, or other file(s)\n",
+ "These files may not show in git status as they may be ignored.\n",
+ "$final.\n";
+ }
-die "This checkout is not clean - $modified modified or untracked file(s)"
- if $modified;
+ if ($inplace) {
+ # We assume that it's safe to copy the runner to the temporary
+ # directory and run it from there, because a shared /tmp should be +t
+ # and hence others are not be able to delete or rename our file.
+ require File::Temp;
+ my ($to, $toname) = File::Temp::tempfile();
+ die "Can't create tempfile"
+ unless $to;
+ open my $from, '<', $runner
+ or die "Can't open '$runner': $!";
+ local $/;
+ print {$to} <$from>
+ or die "Can't copy from '$runner' to '$toname': $!";
+ close $from
+ or die "Can't close '$runner': $!";
+ close $to
+ or die "Can't close '$toname': $!";
+ chmod 0500, $toname
+ or die "Can't chmod 0500, '$toname': $!";
+ $runner = $toname;
+ system $^X, $runner, '--check-args', @ARGV
+ and die "Can't run inplace for some reason. :-(";
+ }
+}
sub validate {
my $commit = shift;
system "git checkout $end" and die;
my $ret = system $^X, $runner, @ARGV;
die "Runner returned $ret for end revision" unless $ret;
+die "Runner returned $ret for end revision, which is a skip"
+ if $ret == 125 * 256;
if (defined $start) {
system "git checkout $start" and die;
die "Runner returned $ret, not 0 for start revision" if $ret;
} else {
# Try to find the earliest version for which the test works
+ my @tried;
foreach my $try (@stable) {
+ if (`git rev-list -n1 $end ^$try^` eq "") {
+ print "Skipping $try, as it is more recent than end commit "
+ . (substr $end, 0, 16) . "\n";
+ # As @stable is supposed to be in age order, arguably we should
+ # last; here.
+ next;
+ }
system "git checkout $try" and die;
my $ret = system $^X, $runner, @ARGV;
if (!$ret) {
$start = $try;
last;
}
+ push @tried, $try;
}
- die "Can't find a suitable start revision to default to. Tried @stable"
+ die "Can't find a suitable start revision to default to.\nTried @tried"
unless defined $start;
}
https://perl5.git.perl.org / perl5.git / blobdiff