Porting/bisect-runner.pl

   1 #!/usr/bin/perl -w
   2 use strict;
   3
   4 use Getopt::Long qw(:config bundling no_auto_abbrev);
   5
   6 my @targets = qw(config.sh miniperl lib/Config.pm perl test_prep);
   7
   8 my %options =
   9     (
  10      target => 'test_prep',
  11      jobs => 9,
  12      'expect-pass' => 1,
  13      clean => 1, # mostly for debugging this
  14     );
  15
  16 my @paths = qw(/usr/local/lib64 /lib64 /usr/lib64);
  17
  18 my %defines =
  19     (
  20      usedevel => '',
  21      optimize => '-g',
  22      cc => 'ccache gcc',
  23      ld => 'gcc',
  24      'libpth' => \@paths,
  25     );
  26
  27 sub usage {
  28     die "$0: [--target=...] [-j4] [--expect-pass=0|1] thing to test";
  29 }
  30
  31 unless(GetOptions(\%options,
  32                   'target=s', 'jobs|j=i', 'expect-pass=i',
  33                   'expect-fail' => sub { $options{'expect-pass'} = 0; },
  34                   'clean!', 'one-liner|e=s', 'match=s', 'force-manifest',
  35                   'test-build', 'check-args', 'A=s@', 'verbose+',
  36                   'D=s@' => sub {
  37                       my (undef, $val) = @_;
  38                       if ($val =~ /\A([^=]+)=(.*)/s) {
  39                           $defines{$1} = length $2 ? $2 : "\0";
  40                       } else {
  41                           $defines{$val} = '';
  42                       }
  43                   },
  44                   'U=s@' => sub {
  45                       $defines{$_[1]} = undef;
  46                   },
  47                  )) {
  48     usage();
  49 }
  50
  51 my ($target, $j, $match) = @options{qw(target jobs match)};
  52
  53 my $exe = $target eq 'perl' || $target eq 'test_prep' ? 'perl' : 'miniperl';
  54 my $expected = $target eq 'test_prep' ? 'perl' : $target;
  55
  56 unshift @ARGV, "./$exe", '-Ilib', '-e', $options{'one-liner'}
  57     if defined $options{'one-liner'};
  58
  59 usage() unless @ARGV || $match || $options{'test-build'};
  60 exit 0 if $options{'check-args'};
  61
  62 die "$0: Can't build $target" unless grep {@targets} $target;
  63
  64 $j = "-j$j" if $j =~ /\A\d+\z/;
  65
  66 # Sadly, however hard we try, I don't think that it will be possible to build
  67 # modules in ext/ on x86_64 Linux before commit e1666bf5602ae794 on 1999/12/29,
  68 # which updated to MakeMaker 3.7, which changed from using a hard coded ld
  69 # in the Makefile to $(LD). On x86_64 Linux the "linker" is gcc.
  70
  71 sub extract_from_file {
  72     my ($file, $rx, $default) = @_;
  73     open my $fh, '<', $file or die "Can't open $file: $!";
  74     while (<$fh>) {
  75         my @got = $_ =~ $rx;
  76         return wantarray ? @got : $got[0]
  77             if @got;
  78     }
  79     return $default if defined $default;
  80     return;
  81 }
  82
  83 sub clean {
  84     if ($options{clean}) {
  85         # Needed, because files that are build products in this checked out
  86         # version might be in git in the next desired version.
  87         system 'git clean -dxf';
  88         # Needed, because at some revisions the build alters checked out files.
  89         # (eg pod/perlapi.pod). Also undoes any changes to makedepend.SH
  90         system 'git reset --hard HEAD';
  91     }
  92 }
  93
  94 sub skip {
  95     my $reason = shift;
  96     clean();
  97     warn "skipping - $reason";
  98     exit 125;
  99 }
 100
 101 sub report_and_exit {
 102     my ($ret, $pass, $fail, $desc) = @_;
 103
 104     clean();
 105
 106     my $got = ($options{'expect-pass'} ? !$ret : $ret) ? 'good' : 'bad';
 107     if ($ret) {
 108         print "$got - $fail $desc\n";
 109     } else {
 110         print "$got - $pass $desc\n";
 111     }
 112
 113     exit($got eq 'bad');
 114 }
 115
 116 sub apply_patch {
 117     my $patch = shift;
 118
 119     open my $fh, '|-', 'patch' or die "Can't run patch: $!";
 120     print $fh $patch;
 121     close $fh or die "Can't patch perl.c: $?, $!";
 122 }
 123
 124 # Not going to assume that system perl is yet new enough to have autodie
 125 system 'git clean -dxf' and die;
 126
 127 if ($match) {
 128     my $matches;
 129     my $re = qr/$match/;
 130     foreach my $file (`git ls-files`) {
 131         chomp $file;
 132         open my $fh, '<', $file or die "Can't open $file: $!";
 133         while (<$fh>) {
 134             if ($_ =~ $re) {
 135                 ++$matches;
 136                 $_ .= "\n" unless /\n\z/;
 137                 print "$file: $_";
 138             }
 139         }
 140         close $fh or die "Can't close $file: $!";
 141     }
 142     report_and_exit(!$matches, 'matches for', 'no matches for', $match);
 143 }
 144
 145 skip('no Configure - is this the //depot/perlext/Compiler branch?')
 146     unless -f 'Configure';
 147
 148 # This changes to PERL_VERSION in 4d8076ea25903dcb in 1999
 149 my $major
 150     = extract_from_file('patchlevel.h',
 151                         qr/^#define\s+(?:PERL_VERSION|PATCHLEVEL)\s+(\d+)\s/,
 152                         0);
 153
 154 if ($major < 1) {
 155     if (extract_from_file('Configure',
 156                           qr/^          \*=\*\) echo "\$1" >> \$optdef;;$/)) {
 157         # This is "        Spaces now allowed in -D command line options.",
 158         # part of commit ecfc54246c2a6f42
 159         apply_patch(<<'EOPATCH');
 160 diff --git a/Configure b/Configure
 161 index 3d3b38d..78ffe16 100755
 162 --- a/Configure
 163 +++ b/Configure
 164 @@ -652,7 +777,8 @@ while test $# -gt 0; do
 165                         echo "$me: use '-U symbol=', not '-D symbol='." >&2
 166                         echo "$me: ignoring -D $1" >&2
 167                         ;;
 168 -               *=*) echo "$1" >> $optdef;;
 169 +               *=*) echo "$1" | \
 170 +                               sed -e "s/'/'\"'\"'/g" -e "s/=\(.*\)/='\1'/" >> $optdef;;
 171                 *) echo "$1='define'" >> $optdef;;
 172                 esac
 173                 shift
 174 EOPATCH
 175     }
 176     if (extract_from_file('Configure', qr/^if \$contains 'd_namlen' \$xinc\b/)) {
 177         # Configure's original simple "grep" for d_namlen falls foul of the
 178         # approach taken by the glibc headers:
 179         # #ifdef _DIRENT_HAVE_D_NAMLEN
 180         # # define _D_EXACT_NAMLEN(d) ((d)->d_namlen)
 181         #
 182         # where _DIRENT_HAVE_D_NAMLEN is not defined on Linux.
 183         # This is also part of commit ecfc54246c2a6f42
 184         apply_patch(<<'EOPATCH');
 185 diff --git a/Configure b/Configure
 186 index 3d3b38d..78ffe16 100755
 187 --- a/Configure
 188 +++ b/Configure
 189 @@ -3935,7 +4045,8 @@ $rm -f try.c
 190
 191  : see if the directory entry stores field length
 192  echo " "
 193 -if $contains 'd_namlen' $xinc >/dev/null 2>&1; then
 194 +$cppstdin $cppflags $cppminus < "$xinc" > try.c
 195 +if $contains 'd_namlen' try.c >/dev/null 2>&1; then
 196         echo "Good, your directory entry keeps length information in d_namlen." >&4
 197         val="$define"
 198  else
 199 EOPATCH
 200     }
 201 }
 202
 203 # There was a bug in makedepend.SH which was fixed in version 96a8704c.
 204 # Symptom was './makedepend: 1: Syntax error: Unterminated quoted string'
 205 # Remove this if you're actually bisecting a problem related to makedepend.SH
 206 system 'git show blead:makedepend.SH > makedepend.SH' and die;
 207
 208 # if Encode is not needed for the test, you can speed up the bisect by
 209 # excluding it from the runs with -Dnoextensions=Encode
 210 # ccache is an easy win. Remove it if it causes problems.
 211 # Commit 1cfa4ec74d4933da adds ignore_versioned_solibs to Configure, and sets it
 212 # to true in hints/linux.sh
 213 # On dromedary, from that point on, Configure (by default) fails to find any
 214 # libraries, because it scans /usr/local/lib /lib /usr/lib, which only contain
 215 # versioned libraries. Without -lm, the build fails.
 216 # Telling /usr/local/lib64 /lib64 /usr/lib64 works from that commit onwards,
 217 # until commit faae14e6e968e1c0 adds it to the hints.
 218 # However, prior to 1cfa4ec74d4933da telling Configure the truth doesn't work,
 219 # because it will spot versioned libraries, pass them to the compiler, and then
 220 # bail out pretty early on. Configure won't let us override libswanted, but it
 221 # will let us override the entire libs list.
 222
 223 unless (extract_from_file('Configure', 'ignore_versioned_solibs')) {
 224     # Before 1cfa4ec74d4933da, so force the libs list.
 225
 226     my @libs;
 227     # This is the current libswanted list from Configure, less the libs removed
 228     # by current hints/linux.sh
 229     foreach my $lib (qw(sfio socket inet nsl nm ndbm gdbm dbm db malloc dl dld
 230                         ld sun m crypt sec util c cposix posix ucb BSD)) {
 231         foreach my $dir (@paths) {
 232             next unless -f "$dir/lib$lib.so";
 233             push @libs, "-l$lib";
 234             last;
 235         }
 236     }
 237     $defines{libs} = \@libs unless exists $defines{libs};
 238 }
 239
 240 # This seems to be necessary to avoid makedepend becoming confused, and hanging
 241 # on stdin. Seems that the code after make shlist || ...here... is never run.
 242 $defines{trnl} = q{'\n'}
 243     if $major < 4 && !exists $defines{trnl};
 244
 245 $defines{usenm} = undef
 246     if $major < 2 && !exists $defines{usenm};
 247
 248 my (@missing, @created_dirs);
 249
 250 if ($options{'force-manifest'}) {
 251     open my $fh, '<', 'MANIFEST'
 252         or die "Could not open MANIFEST: $!";
 253     while (<$fh>) {
 254         next unless /^(\S+)/;
 255         push @missing, $1
 256             unless -f $1;
 257     }
 258     close $fh or die "Can't close MANIFEST: $!";
 259
 260     foreach my $pathname (@missing) {
 261         my @parts = split '/', $pathname;
 262         my $leaf = pop @parts;
 263         my $path = '.';
 264         while (@parts) {
 265             $path .= '/' . shift @parts;
 266             next if -d $path;
 267             mkdir $path, 0700 or die "Can't create $path: $!";
 268             unshift @created_dirs, $path;
 269         }
 270         open $fh, '>', $pathname or die "Can't open $pathname: $!";
 271         close $fh or die "Can't close $pathname: $!";
 272         chmod 0, $pathname or die "Can't chmod 0 $pathname: $!";
 273     }
 274 }
 275
 276 my @ARGS = $target eq 'config.sh' ? '-dEs' : '-des';
 277 foreach my $key (sort keys %defines) {
 278     my $val = $defines{$key};
 279     if (ref $val) {
 280         push @ARGS, "-D$key=@$val";
 281     } elsif (!defined $val) {
 282         push @ARGS, "-U$key";
 283     } elsif (!length $val) {
 284         push @ARGS, "-D$key";
 285     } else {
 286         $val = "" if $val eq "\0";
 287         push @ARGS, "-D$key=$val";
 288     }
 289 }
 290 push @ARGS, map {"-A$_"} @{$options{A}};
 291
 292 # </dev/null because it seems that some earlier versions of Configure can
 293 # call commands in a way that now has them reading from stdin (and hanging)
 294 my $pid = fork;
 295 die "Can't fork: $!" unless defined $pid;
 296 if (!$pid) {
 297     # Before dfe9444ca7881e71, Configure would refuse to run if stdin was not a
 298     # tty. With that commit, the tty requirement was dropped for -de and -dE
 299     if($major > 4) {
 300         open STDIN, '<', '/dev/null';
 301     } elsif (!$options{'force-manifest'}) {
 302         # If a file in MANIFEST is missing, Configure asks if you want to
 303         # continue (the default being 'n'). With stdin closed or /dev/null,
 304         # it exit immediately and the check for config.sh below will skip.
 305         # To avoid a hang, we need to check MANIFEST for ourselves, and skip
 306         # if anything is missing.
 307         open my $fh, '<', 'MANIFEST';
 308         skip("Could not open MANIFEST: $!")
 309             unless $fh;
 310         while (<$fh>) {
 311             next unless /^(\S+)/;
 312             skip("$1 from MANIFEST doesn't exist")
 313                 unless -f $1;
 314         }
 315         close $fh or die "Can't close MANIFEST: $!";
 316     }
 317     exec './Configure', @ARGS;
 318     die "Failed to start Configure: $!";
 319 }
 320 waitpid $pid, 0
 321     or die "wait for Configure, pid $pid failed: $!";
 322
 323 if ($target eq 'config.sh') {
 324     report_and_exit(!-f $target, 'could build', 'could not build', $target);
 325 } elsif (!-f 'config.sh') {
 326     # Skip if something went wrong with Configure
 327
 328     skip('could not build config.sh');
 329 }
 330
 331 # This is probably way too paranoid:
 332 if (@missing) {
 333     my @errors;
 334     require Fcntl;
 335     foreach my $file (@missing) {
 336         my (undef, undef, $mode, undef, undef, undef, undef, $size)
 337             = stat $file;
 338         if (!defined $mode) {
 339             push @errors, "Added file $file has been deleted by Configure";
 340             next;
 341         }
 342         if (Fcntl::S_IMODE($mode) != 0) {
 343             push @errors,
 344                 sprintf 'Added file %s had mode changed by Configure to %03o',
 345                     $file, $mode;
 346         }
 347         if ($size != 0) {
 348             push @errors,
 349                 "Added file $file had sized changed by Configure to $size";
 350         }
 351         unlink $file or die "Can't unlink $file: $!";
 352     }
 353     foreach my $dir (@created_dirs) {
 354         rmdir $dir or die "Can't rmdir $dir: $!";
 355     }
 356     skip("@errors")
 357         if @errors;
 358 }
 359
 360 # Correct makefile for newer GNU gcc
 361 # Only really needed if you comment out the use of blead's makedepend.SH
 362 {
 363     local $^I = "";
 364     local @ARGV = qw(makefile x2p/makefile);
 365     while (<>) {
 366         print unless /<(?:built-in|command|stdin)/;
 367     }
 368 }
 369
 370 if ($major == 2 && extract_from_file('perl.c', qr/^     fclose\(e_fp\);$/)) {
 371     # need to patch perl.c to avoid calling fclose() twice on e_fp when using -e
 372     # This diff is part of commit ab821d7fdc14a438. The second close was
 373     # introduced with perl-5.002, commit a5f75d667838e8e7
 374     # Might want a6c477ed8d4864e6 too, for the corresponding change to pp_ctl.c
 375     # (likely without this, eval will have "fun")
 376     apply_patch(<<'EOPATCH');
 377 diff --git a/perl.c b/perl.c
 378 index 03c4d48..3c814a2 100644
 379 --- a/perl.c
 380 +++ b/perl.c
 381 @@ -252,6 +252,7 @@ setuid perl scripts securely.\n");
 382  #ifndef VMS  /* VMS doesn't have environ array */
 383      origenviron = environ;
 384  #endif
 385 +    e_tmpname = Nullch;
 386
 387      if (do_undump) {
 388
 389 @@ -405,6 +406,7 @@ setuid perl scripts securely.\n");
 390      if (e_fp) {
 391         if (Fflush(e_fp) || ferror(e_fp) || fclose(e_fp))
 392             croak("Can't write to temp file for -e: %s", Strerror(errno));
 393 +       e_fp = Nullfp;
 394         argc++,argv--;
 395         scriptname = e_tmpname;
 396      }
 397 @@ -470,10 +472,10 @@ setuid perl scripts securely.\n");
 398      curcop->cop_line = 0;
 399      curstash = defstash;
 400      preprocess = FALSE;
 401 -    if (e_fp) {
 402 -       fclose(e_fp);
 403 -       e_fp = Nullfp;
 404 +    if (e_tmpname) {
 405         (void)UNLINK(e_tmpname);
 406 +       Safefree(e_tmpname);
 407 +       e_tmpname = Nullch;
 408      }
 409
 410      /* now that script is parsed, we can modify record separator */
 411 @@ -1369,7 +1371,7 @@ SV *sv;
 412         scriptname = xfound;
 413      }
 414
 415 -    origfilename = savepv(e_fp ? "-e" : scriptname);
 416 +    origfilename = savepv(e_tmpname ? "-e" : scriptname);
 417      curcop->cop_filegv = gv_fetchfile(origfilename);
 418      if (strEQ(origfilename,"-"))
 419         scriptname = "";
 420
 421 EOPATCH
 422 }
 423
 424 # Parallel build for miniperl is safe
 425 system "make $j miniperl";
 426
 427 if ($target ne 'miniperl') {
 428     # Nearly all parallel build issues fixed by 5.10.0. Untrustworthy before that.
 429     $j = '' unless $major > 10;
 430
 431     if ($target eq 'test_prep') {
 432         if ($major < 8) {
 433             # test-prep was added in 5.004_01, 3e3baf6d63945cb6.
 434             # renamed to test_prep in 2001 in 5fe84fd29acaf55c.
 435             # earlier than that, just make test. It will be fast enough.
 436             $target = extract_from_file('Makefile.SH', qr/^(test[-_]prep):/,
 437                                         'test');
 438         }
 439     }
 440
 441     system "make $j $target";
 442 }
 443
 444 my $missing_target = $expected =~ /perl$/ ? !-x $expected : !-r $expected;
 445
 446 if ($options{'test-build'}) {
 447     report_and_exit($missing_target, 'could build', 'could not build', $target);
 448 } elsif ($missing_target) {
 449     skip("could not build $target");
 450 }
 451
 452 # This is what we came here to run:
 453 my $ret = system @ARGV;
 454
 455 report_and_exit($ret, 'zero exit from', 'non-zero exit from', "@ARGV");
 456
 457 # Local variables:
 458 # cperl-indent-level: 4
 459 # indent-tabs-mode: nil
 460 # End:
 461 #
 462 # ex: set ts=8 sts=4 sw=4 et: