Update HTTP-Tiny to CPAN version 0.033

[perl5.git] / Porting / bisect.pl

diff --git a/Porting/bisect.pl b/Porting/bisect.pl
index f5c401b..81a7d9b 100755 (executable)
--- a/Porting/bisect.pl
+++ b/Porting/bisect.pl
@@ -11,9 +11,9 @@ Documentation for this is in bisect-runner.pl
 # Which isn't what we want.
 use Getopt::Long qw(:config pass_through no_auto_abbrev);
 
-my ($start, $end, $validate, $usage, $bad, $jobs, $make);
+my ($start, $end, $validate, $usage, $bad, $jobs, $make, $gold);
 $bad = !GetOptions('start=s' => \$start, 'end=s' => \$end,
-                   'jobs|j=i' => \$jobs, 'make=s' => \$make,
+                   '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;
@@ -27,14 +27,6 @@ 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;
-    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;
-}
-
 my $start_time = time;
 
 if (!defined $jobs &&
@@ -58,7 +50,10 @@ 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.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';
@@ -71,7 +66,21 @@ my @stable = qw(perl-5.005 perl-5.6.0 perl-5.8.0 v5.10.0 v5.12.0 v5.14.0);
     }
 }
 
-$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
@@ -82,14 +91,51 @@ foreach ($start, $end) {
     chomp;
 }
 
-my $modified = 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;
 
-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",
-    "You can use 'git clean -Xdf' to cleanup the ignored files.\n"
-    if $modified;
+    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";
+    }
+
+    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;