This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Avoid bisect-runner.pl hanging on pre-5.004 if a file in MANIFEST is missing.
[perl5.git] / Porting / bisect-runner.pl
index a1c351a..30daa60 100755 (executable)
@@ -3,13 +3,14 @@ use strict;
 
 use Getopt::Long;
 
-my @targets = qw(miniperl perl test_prep);
+my @targets = qw(miniperl lib/Config.pm perl test_prep);
 
 my $target = 'test_prep';
 my $j = '9';
 my $test_should_pass = 1;
 my $clean = 1;
 my $one_liner;
+my $match;
 
 sub usage {
     die "$0: [--target=...] [-j=4] [--expect-pass=0|1] thing to test";
@@ -21,15 +22,17 @@ unless(GetOptions('target=s' => \$target,
                  'expect-fail' => sub { $test_should_pass = 0; },
                  'clean!' => \$clean, # mostly for debugging this
                  'one-liner|e=s' => \$one_liner,
+                  'match=s' => \$match,
                 )) {
     usage();
 }
 
-my $expected = $target eq 'miniperl' ? 'miniperl' : 'perl';
+my $exe = $target eq 'perl' || $target eq 'test_prep' ? 'perl' : 'miniperl';
+my $expected = $target eq 'test_prep' ? 'perl' : $target;
 
-unshift @ARGV, "./$expected", '-e', $one_liner if defined $one_liner;
+unshift @ARGV, "./$exe", '-Ilib', '-e', $one_liner if defined $one_liner;
 
-usage() unless @ARGV;
+usage() unless @ARGV || $match;
 
 die "$0: Can't build $target" unless grep {@targets} $target;
 
@@ -47,9 +50,69 @@ sub extract_from_file {
     return;
 }
 
+sub clean {
+    if ($clean) {
+        # Needed, because files that are build products in this checked out
+        # version might be in git in the next desired version.
+        system 'git clean -dxf';
+        # Needed, because at some revisions the build alters checked out files.
+        # (eg pod/perlapi.pod). Also undoes any changes to makedepend.SH
+        system 'git reset --hard HEAD';
+    }
+}
+
+sub skip {
+    my $reason = shift;
+    clean();
+    warn "skipping - $reason";
+    exit 125;
+}
+
+sub report_and_exit {
+    my ($ret, $pass, $fail, $desc) = @_;
+
+    clean();
+
+    my $got = ($test_should_pass ? !$ret : $ret) ? 'good' : 'bad';
+    if ($ret) {
+        print "$got - $fail $desc\n";
+    } else {
+        print "$got - $pass $desc\n";
+    }
+
+    exit($got eq 'bad');
+}
+
 # Not going to assume that system perl is yet new enough to have autodie
 system 'git clean -dxf' and die;
 
+if ($match) {
+    my $matches;
+    my $re = qr/$match/;
+    foreach my $file (`git ls-files`) {
+        chomp $file;
+        open my $fh, '<', $file or die "Can't open $file: $!";
+        while (<$fh>) {
+            if ($_ =~ $re) {
+                ++$matches;
+                $_ .= "\n" unless /\n\z/;
+                print "$file: $_";
+            }
+        }
+        close $fh or die "Can't close $file: $!";
+    }
+    report_and_exit(!$matches, 'matches for', 'no matches for', $match);
+}
+
+skip('no Configure - is this the //depot/perlext/Compiler branch?')
+    unless -f 'Configure';
+
+# This changes to PERL_VERSION in 4d8076ea25903dcb in 1999
+my $major
+    = extract_from_file('patchlevel.h',
+                       qr/^#define\s+(?:PERL_VERSION|PATCHLEVEL)\s+(\d+)\s/,
+                       0);
+
 # There was a bug in makedepend.SH which was fixed in version 96a8704c.
 # Symptom was './makedepend: 1: Syntax error: Unterminated quoted string'
 # Remove this if you're actually bisecting a problem related to makedepend.SH
@@ -92,12 +155,36 @@ unless (extract_from_file('Configure', 'ignore_versioned_solibs')) {
     push @ARGS, "-Dlibs=@libs";
 }
 
+# This seems to be necessary to avoid makedepend becoming confused, and hanging
+# on stdin. Seems that the code after make shlist || ...here... is never run.
+push @ARGS, q{-Dtrnl='\n'}
+    if $major < 4;
+
 # </dev/null because it seems that some earlier versions of Configure can
 # call commands in a way that now has them reading from stdin (and hanging)
 my $pid = fork;
 die "Can't fork: $!" unless defined $pid;
 if (!$pid) {
-    open STDIN, '<', '/dev/null';
+    # Before dfe9444ca7881e71, Configure would refuse to run if stdin was not a
+    # tty. With that commit, the tty requirement was dropped for -de and -dE
+    if($major > 4) {
+        open STDIN, '<', '/dev/null' 
+    } else {
+        # If a file in MANIFEST is missing, Configure asks if you want to
+        # continue (the default being 'n'). With stdin closed or /dev/null,
+        # it exit immediately and the check for config.sh below will skip.
+        # To avoid a hang, we need to check MANIFEST for ourselves, and skip
+        # if anything is missing.
+        open my $fh, '<', 'MANIFEST';
+        skip("Could not open MANIFEST: $!")
+            unless $fh;
+        while (<$fh>) {
+            next unless /^(\S+)/;
+            skip("$1 from MANIFEST doesn't exist")
+                unless -f $1;
+        }
+        close $fh or die "Can't close MANIFEST: $!";
+    }
     exec './Configure', @ARGS;
     die "Failed to start Configure: $!";
 }
@@ -105,10 +192,7 @@ waitpid $pid, 0
     or die "wait for Configure, pid $pid failed: $!";
 
 # Skip if something went wrong with Configure
-unless (-f 'config.sh') {
-    warn "skipping - no config.sh";
-    exit 125;
-}
+skip('no config.sh') unless -f 'config.sh';
 
 # Correct makefile for newer GNU gcc
 # Only really needed if you comment out the use of blead's makedepend.SH
@@ -119,12 +203,6 @@ unless (-f 'config.sh') {
        print unless /<(?:built-in|command|stdin)/;
     }
 }
-           
-# This changes to PERL_VERSION in 4d8076ea25903dcb in 1999
-my $major
-    = extract_from_file('patchlevel.h',
-                       qr/^#define\s+(?:PERL_VERSION|PATCHLEVEL)\s+(\d+)\s/,
-                       0);
 
 # Parallel build for miniperl is safe
 system "make $j miniperl";
@@ -146,32 +224,13 @@ if ($target ne 'miniperl') {
     system "make $j $target";
 }
 
-if (!-x $expected) {
-    warn "skipping - could not build $target";
-    exit 125;
-}
+skip("could not build $target")
+    if $expected =~ /perl$/ ? !-x $expected : !-r $expected;
 
 # This is what we came here to run:
 my $ret = system @ARGV;
 
-if ($clean) {
-    # Needed, because files that are build products in this checked out version
-    # might be in git in the next desired version.
-    system 'git clean -dxf';
-    # Needed, because at some revisions the build alters checked out files.
-    # (eg pod/perlapi.pod). Also undoes any changes to makedepend.SH
-    system 'git reset --hard HEAD';
-}
-
-my $got = ($test_should_pass ? !$ret : $ret) ? 'good' : 'bad';
-
-if ($ret) {
-    print "$got - non-zero exit from @ARGV\n";
-} else {
-    print "$got - zero exit from @ARGV\n";
-}
-
-exit($got eq 'bad');
+report_and_exit($ret, 'zero exit from', 'non-zero exit from', "@ARGV");
 
 # Local variables:
 # cperl-indent-level: 4