This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Cloning a format whose outside has been undefined
[perl5.git] / Porting / bisect.pl
index d49223d..29e3ded 100755 (executable)
@@ -1,22 +1,31 @@
 #!/usr/bin/perl -w
 use strict;
 
-my $start_time = time;
+=for comment
+
+Documentation for this is in bisect-runner.pl
+
+=cut
 
 # 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);
+$bad = !GetOptions('start=s' => \$start, 'end=s' => \$end,
+                   validate => \$validate, 'usage|help|?' => \$usage);
+unshift @ARGV, '--help' if $bad || $usage;
+unshift @ARGV, '--validate' if $validate;
 
 my $runner = $0;
 $runner =~ s/bisect\.pl/bisect-runner.pl/;
 
 die "Can't find bisect runner $runner" unless -f $runner;
 
+system $^X, $runner, '--check-args', '--check-shebang', @ARGV and exit 255;
+exit 255 if $bad;
+exit 0 if $usage;
+
 {
     my ($dev0, $ino0) = stat $0;
     die "Can't stat $0: $!" unless defined $ino0;
@@ -25,11 +34,21 @@ die "Can't find bisect runner $runner" unless -f $runner;
       if defined $dev1 && $dev0 == $dev1 && $ino0 == $ino1;
 }
 
-system $^X, $runner, '--check-args', @ARGV and exit 255;
+my $start_time = time;
 
 # 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 = qw(perl-5.005 perl-5.6.0 perl-5.8.0 v5.10.0 v5.12.0 v5.14.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;
 
@@ -63,11 +82,18 @@ sub validate {
     die "Runner returned $ret, not 0 for revision $commit" if $ret;
     system 'git clean -dxf </dev/null' and die;
     system 'git reset --hard HEAD </dev/null' and die;
+    return $commit;
 }
 
 if ($validate) {
-    validate $_ foreach 'blead', reverse @stable;
-    exit 0;
+    require Text::Wrap;
+    my @built = map {validate $_} 'blead', reverse @stable;
+    if (@built) {
+        print Text::Wrap::wrap("", "", "Successfully validated @built\n");
+        exit 0;
+    }
+    print "Did not validate anything\n";
+    exit 1;
 }
 
 my $git_version = `git --version`;
@@ -95,15 +121,24 @@ if (defined $start) {
     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;
 }
 
@@ -121,6 +156,12 @@ END {
         if defined $start_time;
 }
 
+=for comment
+
+Documentation for this is in bisect-runner.pl
+
+=cut
+
 # Local variables:
 # cperl-indent-level: 4
 # indent-tabs-mode: nil