X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/3f14869bb44746c853564775631134b778f620d2..86905c1e468b4df7f3ed096390f8d1a3e28dc801:/Porting/bisect-runner.pl diff --git a/Porting/bisect-runner.pl b/Porting/bisect-runner.pl index a701aa4..2f29840 100755 --- a/Porting/bisect-runner.pl +++ b/Porting/bisect-runner.pl @@ -4,25 +4,12 @@ use strict; use Getopt::Long qw(:config bundling no_auto_abbrev); use Pod::Usage; use Config; -use Carp; my @targets = qw(config.sh config.h miniperl lib/Config.pm Fcntl perl test_prep); -my $cpus; -if (open my $fh, '<', '/proc/cpuinfo') { - while (<$fh>) { - ++$cpus if /^processor\s+:\s+\d+$/; - } -} elsif (-x '/sbin/sysctl') { - $cpus = 1 + $1 if `/sbin/sysctl hw.ncpu` =~ /^hw\.ncpu: (\d+)$/; -} elsif (-x '/usr/bin/getconf') { - $cpus = 1 + $1 if `/usr/bin/getconf _NPROCESSORS_ONLN` =~ /^(\d+)$/; -} - my %options = ( - jobs => defined $cpus ? $cpus + 1 : 2, 'expect-pass' => 1, clean => 1, # mostly for debugging this ); @@ -53,17 +40,21 @@ my %defines = ( usedevel => '', optimize => '-g', - cc => 'ccache cc', ld => 'cc', ($linux64 ? (libpth => \@paths) : ()), ); unless(GetOptions(\%options, - 'target=s', 'jobs|j=i', 'expect-pass=i', + 'target=s', 'make=s', 'jobs|j=i', 'expect-pass=i', 'expect-fail' => sub { $options{'expect-pass'} = 0; }, - 'clean!', 'one-liner|e=s', 'match=s', 'force-manifest', - 'force-regen', 'test-build', 'check-args', 'A=s@', - 'usage|help|?', + 'clean!', 'one-liner|e=s', 'c', 'l', 'w', 'match=s', + 'no-match=s' => sub { + $options{match} = $_[1]; + $options{'expect-pass'} = 0; + }, + 'force-manifest', 'force-regen', 'test-build', 'validate', + 'all-fixups', + 'check-args', 'check-shebang!', 'usage|help|?', 'A=s@', 'D=s@' => sub { my (undef, $val) = @_; if ($val =~ /\A([^=]+)=(.*)/s) { @@ -79,11 +70,19 @@ unless(GetOptions(\%options, pod2usage(exitval => 255, verbose => 1); } -my ($target, $j, $match) = @options{qw(target jobs match)}; +my ($target, $match) = @options{qw(target match)}; + +@ARGV = ('sh', '-c', 'cd t && ./perl TEST base/*.t') + if $options{validate} && !@ARGV; -pod2usage(exitval => 255, verbose => 1) if $options{usage}; +pod2usage(exitval => 0, verbose => 2) if $options{usage}; pod2usage(exitval => 255, verbose => 1) unless @ARGV || $match || $options{'test-build'} || defined $options{'one-liner'}; +pod2usage(exitval => 255, verbose => 1) + if !$options{'one-liner'} && ($options{l} || $options{w}); + +check_shebang($ARGV[0]) + if $options{'check-shebang'} && @ARGV && !$options{match}; exit 0 if $options{'check-args'}; @@ -97,12 +96,14 @@ bisect.pl - use git bisect to pinpoint changes .../Porting/bisect.pl -e 'my $a := 2;' # When did this stop being an error? .../Porting/bisect.pl --expect-fail -e '1 // 2' - # When did this stop matching? + # When were all lines matching this pattern removed from all files? .../Porting/bisect.pl --match '\b(?:PL_)hash_seed_set\b' - # When did this start matching? + # When was some line matching this pattern added to some file? .../Porting/bisect.pl --expect-fail --match '\buseithreads\b' - # When did this test program stop working? + # When did this test program stop exiting 0? .../Porting/bisect.pl -- ./perl -Ilib ../test_prog.pl + # When did this test start failing? + .../Porting/bisect.pl -- ./perl -Ilib t/TEST op/sort.t # When did this first become valid syntax? .../Porting/bisect.pl --target=miniperl --end=v5.10.0 \ --expect-fail -e 'my $a := 2;' @@ -127,11 +128,11 @@ Which commit caused this example code to start working? =item * -Which commit added the first to match this regex? +Which commit added the first file to match this regex? =item * -Which commit removed the last to match this regex? +Which commit removed the last file to match this regex? =back @@ -141,10 +142,12 @@ end revisions. By default F will process all options, then use the rest of the command line as arguments to list C to run a test case. By default, the test case should pass (exit with 0) on earlier perls, and fail (exit -non-zero) on I. F will use F to find the -earliest stable perl version on which the test case passes, check that it -fails on blead, and then use F with C to -find the commit which caused the failure. +non-zero) on I (note that running most of perl's test files directly +won't do this, you'll need to run them through a harness to get the proper +error code). F will use F to find the earliest +stable perl version on which the test case passes, check that it fails on +blead, and then use F with C to find the +commit which caused the failure. Because the test case is the complete argument to C, it is easy to run something other than the F built, if necessary. If you need to run @@ -177,8 +180,10 @@ If your F is old enough you can override this with C<-Unoextensions>. Earliest revision to test, as a I (a tag, commit or anything else C understands as a revision). If not specified, F will -search stable perl releases from 5.002 to 5.14.0 until it finds one where -the test case passes. +search stable perl releases until it finds one where the test case passes. +The default is to search from 5.002 to 5.14.0. If F detects that +the checkout is on a case insensitive file system, it will search from +5.005 to 5.14.0 =item * @@ -270,6 +275,33 @@ which interferes with detecting errors in the example code itself. =item * +-c + +Add C<-c> to the command line, to cause perl to exit after syntax checking. + +=item * + +-l + +Add C<-l> to the command line with C<-e> + +This will automatically append a newline to every output line of your testcase. +Note that you can't specify an argument to F's C<-l> with this, as it's +not feasible to emulate F's somewhat quirky switch parsing with +L. If you need the full flexibility of C<-l>, you need to write +a full test case, instead of using C's C<-e> shortcut. + +=item * + +-w + +Add C<-w> to the command line with C<-e> + +It's not valid to pass C<-c>, C<-l> or C<-w> to C unless you are +also using C<-e> + +=item * + --expect-fail The test case should fail for the I revision, and pass for the I @@ -277,17 +309,23 @@ revision. The bisect run will find the first commit where it passes. =item * --Dnoextensions=Encode +-D I =item * --Uusedevel +-U I =item * --Accflags=-DNO_MATHOMS +-A I + +Arguments (C<-A>, C<-D>, C<-U>) to pass to F. For example, -Arguments to pass to F. Repeated C<-A> arguments are passed + -Dnoextensions=Encode + -Uusedevel + -Accflags=-DNO_MATHOMS + +Repeated C<-A> arguments are passed through as is. C<-D> and C<-U> are processed in order, and override previous settings for the same parameter. F emulates C<-Dnoextensions> when F itself does not provide it, as it's @@ -295,29 +333,68 @@ often very useful to be able to disable some XS extensions. =item * +--make I + +The C command to use. If this not set, F is used. If this is +set, it also adds a C<-Dmake=...> else some recursive make invocations +in extensions may fail. Typically one would use this as C<--make gmake> +to use F in place of the system F. + +=item * + --jobs I =item * -j I -Number of C jobs to run in parallel. If F exists and -can be parsed, or F exists and reports C, or -F exists and reports C<_NPROCESSORS_ONLN> defaults to 1 + -I. Otherwise defaults to 2. +Number of C jobs to run in parallel. A value of 0 suppresses +parallelism. If F exists and can be parsed, or F +exists and reports C, or F exists and reports +C<_NPROCESSORS_ONLN> defaults to 1 + I. On HP-UX with the +system make defaults to 0, otherwise defaults to 2. =item * --match pattern -Instead of running a test program to determine I or I, pass -if the given regex matches, and hence search for the commit that removes -the last matching file. +=item * + +--no-match pattern + +Instead of running a test program to determine I or I, +C<--match> will pass if the given regex matches, and hence search for the +commit that removes the last matching file. C<--no-match> inverts the test, +to search for the first commit that adds files that match. + +The remaining command line arguments are treated as glob patterns for files +to match against. If none are specified, then they default as follows: + +=over 4 + +=item * If no I is specified, the match is against all files in the -repository (which is fast). If a I is specified, that target is -built, and the match is against only the built files. C<--expect-fail> can -be used with C<--match> to search for a commit that adds files that match. +repository (which is fast). + +=item * + +If a I is specified, that target is built, and the match is against +only the built files. + +=back + +Treating the command line arguments as glob patterns should not cause +problems, as the perl distribution has never shipped or built files with +names that contain characters which are globbing metacharacters. + +Anything which is not a readable file is ignored, instead of generating an +error. (If you want an error, run C or C as a test case). This +permits one to easily search in a file that changed its name. For example: + + .../Porting/bisect.pl --match 'Pod.*Functions' 'pod/buildtoc*' + +C<--no-match ...> is implemented as C<--expect-fail --match ...> =item * @@ -375,6 +452,20 @@ C<--expect-pass=0> is equivalent to C<--expect-fail>. I<1> is the default. =item * +--all-fixups + +F will minimally patch various files on a platform and +version dependent basis to get the build to complete. Normally it defers +doing this as long as possible - C<.SH> files aren't patched until after +F is run, and C and C code isn't patched until after +F is built. If C<--all-fixups> is specified, all the fixups are +done before running C. In rare cases adding this may cause a +bisect to abort, because an inapplicable patch or other fixup is attempted +for a revision which would usually have already Ied. If this happens, +please report it as a bug, giving the OS and problem revision. + +=item * + --no-clean Tell F not to clean up after the build. This allows one @@ -388,12 +479,16 @@ Passing this to F will likely cause the bisect to fail badly. --validate Test that all stable revisions can be built. By default, attempts to build -I, I .. I. Stops at the first failure, without +I, I .. I (or I on a case insensitive +file system). Stops at the first failure, without cleaning the checkout. Use I<--start> to specify the earliest revision to test, I<--end> to specify the most recent. Useful for validating a new OS/CPU/compiler combination. For example - ../perl/Porting/bisect.pl --validate -e'print "Hello from $]\n"' + ../perl/Porting/bisect.pl --validate -le 'print "Hello from $]"' + +If no testcase is specified, the default is to use F to run +F =item * @@ -403,6 +498,20 @@ Validate the options and arguments, and exit silently if they are valid. =item * +--check-shebang + +Validate that the test case isn't an executable file with a +C<#!/usr/bin/perl> line (or similar). As F does B +prepend C<./perl> to the test case, a I<#!> line specifying an external +F binary will cause the test case to always run with I F, +not the F built by the bisect runner. Likely this is not what you +wanted. If your test case is actually a wrapper script to run other +commands, you should run it with an explicit interpreter, to be clear. For +example, instead of C<../perl/Porting/bisect.pl ~/test/testcase.pl> you'd +run C<../perl/Porting/bisect.pl /usr/bin/perl ~/test/testcase.pl> + +=item * + --usage =item * @@ -419,9 +528,43 @@ Display the usage information and exit. =cut -die "$0: Can't build $target" if defined $target && !grep {@targets} $target; +# Ensure we always exit with 255, to cause git bisect to abort. +sub croak_255 { + my $message = join '', @_; + if ($message =~ /\n\z/) { + print STDERR $message; + } else { + my (undef, $file, $line) = caller 1; + print STDERR "@_ at $file line $line\n"; + } + exit 255; +} -$j = "-j$j" if $j =~ /\A\d+\z/; +sub die_255 { + croak_255(@_); +} + +die_255("$0: Can't build $target") + if defined $target && !grep {@targets} $target; + +unless (exists $defines{cc}) { + # If it fails, the heuristic of 63f9ec3008baf7d6 is noisy, and hence + # confusing. + # FIXME - really it should be replaced with a proper test of + # "can we build something?" and a helpful diagnostic if we can't. + # For now, simply move it here. + $defines{cc} = (`ccache -V`, $?) ? 'cc' : 'ccache cc'; +} + +my $j = $options{jobs} ? "-j$options{jobs}" : ''; + +if (exists $options{make}) { + if (!exists $defines{make}) { + $defines{make} = $options{make}; + } +} else { + $options{make} = 'make'; +} # Sadly, however hard we try, I don't think that it will be possible to build # modules in ext/ on x86_64 Linux before commit e1666bf5602ae794 on 1999/12/29, @@ -431,7 +574,7 @@ $j = "-j$j" if $j =~ /\A\d+\z/; sub open_or_die { my $file = shift; my $mode = @_ ? shift : '<'; - open my $fh, $mode, $file or croak("Can't open $file: $!"); + open my $fh, $mode, $file or croak_255("Can't open $file: $!"); ${*$fh{SCALAR}} = $file; return $fh; } @@ -439,8 +582,13 @@ sub open_or_die { sub close_or_die { my $fh = shift; return if close $fh; - croak("Can't close: $!") unless ref $fh eq 'GLOB'; - croak("Can't close ${*$fh{SCALAR}}: $!"); + croak_255("Can't close: $!") unless ref $fh eq 'GLOB'; + croak_255("Can't close ${*$fh{SCALAR}}: $!"); +} + +sub system_or_die { + my $command = '; - die "Can't read $file: $!" unless defined $orig && close $fh; + die_255("Can't read $file: $!") unless defined $orig && close $fh; my $new = $munger->($orig); return if $new eq $orig; $fh = open_or_die($file, '>'); - print $fh $new or die "Can't print to $file: $!"; + print $fh $new or die_255("Can't print to $file: $!"); close_or_die($fh); } -sub apply_patch { - my $patch = shift; +# AIX supplies a pre-historic patch program, which certainly predates Linux +# and is probably older than NT. It can't cope with unified diffs. Meanwhile, +# it's hard enough to get git diff to output context diffs, let alone git show, +# and nearly all the patches embedded here are unified. So it seems that the +# path of least resistance is to convert unified diffs to context diffs: + +sub process_hunk { + my ($from_out, $to_out, $has_from, $has_to, $delete, $add) = @_; + ++$$has_from if $delete; + ++$$has_to if $add; + + if ($delete && $add) { + $$from_out .= "! $_\n" foreach @$delete; + $$to_out .= "! $_\n" foreach @$add; + } elsif ($delete) { + $$from_out .= "- $_\n" foreach @$delete; + } elsif ($add) { + $$to_out .= "+ $_\n" foreach @$add; + } +} + +# This isn't quite general purpose, as it can't cope with +# '\ No newline at end of file' +sub ud2cd { + my $diff_in = shift; + my $diff_out = ''; + + # Stuff before the diff + while ($diff_in =~ s/\A(?!\*\*\* )(?!--- )([^\n]*\n?)//ms && length $1) { + $diff_out .= $1; + } + + if (!length $diff_in) { + die_255("That didn't seem to be a diff"); + } + + if ($diff_in =~ /\A\*\*\* /ms) { + warn "Seems to be a context diff already\n"; + return $diff_out . $diff_in; + } - my ($file) = $patch =~ qr!^--- a/(\S+)\n\+\+\+ b/\1!sm; - open my $fh, '|-', 'patch', '-p1' or die "Can't run patch: $!"; - print $fh $patch; + # Loop for files + FILE: while (1) { + if ($diff_in =~ s/\A((?:diff |index )[^\n]+\n)//ms) { + $diff_out .= $1; + next; + } + if ($diff_in !~ /\A--- /ms) { + # Stuff after the diff; + return $diff_out . $diff_in; + } + $diff_in =~ s/\A([^\n]+\n?)//ms; + my $line = $1; + die_255("Can't parse '$line'") unless $line =~ s/\A--- /*** /ms; + $diff_out .= $line; + $diff_in =~ s/\A([^\n]+\n?)//ms; + $line = $1; + die_255("Can't parse '$line'") unless $line =~ s/\A\+\+\+ /--- /ms; + $diff_out .= $line; + + # Loop for hunks + while (1) { + next FILE + unless $diff_in =~ s/\A\@\@ (-([0-9]+),([0-9]+) \+([0-9]+),([0-9]+)) \@\@[^\n]*\n?//; + my ($hunk, $from_start, $from_count, $to_start, $to_count) + = ($1, $2, $3, $4, $5); + my $from_end = $from_start + $from_count - 1; + my $to_end = $to_start + $to_count - 1; + my ($from_out, $to_out, $has_from, $has_to, $add, $delete); + while (length $diff_in && ($from_count || $to_count)) { + die_255("Confused in $hunk") + unless $diff_in =~ s/\A([^\n]*)\n//ms; + my $line = $1; + $line = ' ' unless length $line; + if ($line =~ /^ .*/) { + process_hunk(\$from_out, \$to_out, \$has_from, \$has_to, + $delete, $add); + undef $delete; + undef $add; + $from_out .= " $line\n"; + $to_out .= " $line\n"; + --$from_count; + --$to_count; + } elsif ($line =~ /^-(.*)/) { + push @$delete, $1; + --$from_count; + } elsif ($line =~ /^\+(.*)/) { + push @$add, $1; + --$to_count; + } else { + die_255("Can't parse '$line' as part of hunk $hunk"); + } + } + process_hunk(\$from_out, \$to_out, \$has_from, \$has_to, + $delete, $add); + die_255("No lines in hunk $hunk") + unless length $from_out || length $to_out; + die_255("No changes in hunk $hunk") + unless $has_from || $has_to; + $diff_out .= "***************\n"; + $diff_out .= "*** $from_start,$from_end ****\n"; + $diff_out .= $from_out if $has_from; + $diff_out .= "--- $to_start,$to_end ----\n"; + $diff_out .= $to_out if $has_to; + } + } +} + +{ + my $use_context; + + sub placate_patch_prog { + my $patch = shift; + + if (!defined $use_context) { + my $version = `patch -v 2>&1`; + die_255("Can't run `patch -v`, \$?=$?, bailing out") + unless defined $version; + if ($version =~ /Free Software Foundation/) { + $use_context = 0; + } elsif ($version =~ /Header: patch\.c,v.*\blwall\b/) { + # The system patch is older than Linux, and probably older than + # Windows NT. + $use_context = 1; + } elsif ($version =~ /Header: patch\.c,v.*\babhinav\b/) { + # Thank you HP. No, we have no idea *which* version this is: + # $Header: patch.c,v 76.1.1.2.1.3 2001/12/03 12:24:52 abhinav Exp $ + $use_context = 1; + } else { + # Don't know. + $use_context = 0; + } + } + + return $use_context ? ud2cd($patch) : $patch; + } +} + +sub apply_patch { + my ($patch, $what, $files) = @_; + $what = 'patch' unless defined $what; + unless (defined $files) { + $patch =~ m!^--- a/(\S+)\n\+\+\+ b/\1!sm; + $files = " $1"; + } + my $patch_to_use = placate_patch_prog($patch); + open my $fh, '|-', 'patch', '-p1' or die_255("Can't run patch: $!"); + print $fh $patch_to_use; return if close $fh; print STDERR "Patch is <<'EOPATCH'\n${patch}EOPATCH\n"; - die "Can't patch $file: $?, $!"; + print STDERR "\nConverted to a context diff <<'EOCONTEXT'\n${patch_to_use}EOCONTEXT\n" + if $patch_to_use ne $patch; + die_255("Can't $what$files: $?, $!"); } sub apply_commit { my ($commit, @files) = @_; - return unless system "git show $commit @files | patch -p1"; - die "Can't apply commit $commit to @files" if @files; - die "Can't apply commit $commit"; + my $patch = `git show $commit @files`; + if (!defined $patch) { + die_255("Can't get commit $commit for @files: $?") if @files; + die_255("Can't get commit $commit: $?"); + } + apply_patch($patch, "patch $commit", @files ? " for @files" : ''); } sub revert_commit { my ($commit, @files) = @_; - return unless system "git show -R $commit @files | patch -p1"; - die "Can't apply revert $commit from @files" if @files; - die "Can't apply revert $commit"; + my $patch = `git show -R $commit @files`; + if (!defined $patch) { + die_255("Can't get revert commit $commit for @files: $?") if @files; + die_255("Can't get revert commit $commit: $?"); + } + apply_patch($patch, "revert $commit", @files ? " for @files" : ''); } sub checkout_file { my ($file, $commit) = @_; $commit ||= 'blead'; system "git show $commit:$file > $file ; + return unless $line =~ m{\A#!(/\S+/perl\S*)\s}; + die_255("$file will always be run by $1 +It won't be tested by the ./perl we build. +If you intended to run it with that perl binary, please change your +test case to + + $1 @ARGV + +If you intended to test it with the ./perl we build, please change your +test case to + + ./perl -Ilib @ARGV + +[You may also need to add -- before ./perl to prevent that -Ilib as being +parsed as an argument to bisect.pl] + +Bailing out"); } sub clean { @@ -534,12 +862,21 @@ sub report_and_exit { } sub match_and_exit { - my $target = shift; + my ($target, @globs) = @_; my $matches = 0; my $re = qr/$match/; my @files; - { + if (@globs) { + require File::Glob; + foreach (sort map { File::Glob::bsd_glob($_)} @globs) { + if (!-f $_ || !-r _) { + warn "Skipping matching '$_' as it is not a readable file\n"; + } else { + push @files, $_; + } + } + } else { local $/ = "\0"; @files = defined $target ? `git ls-files -o -z`: `git ls-files -z`; chomp @files; @@ -566,16 +903,25 @@ sub match_and_exit { } # Not going to assume that system perl is yet new enough to have autodie -system 'git clean -dxf ' fails, and + # Makefile tries to run minitest. + + # Of course, helpfully sometimes it's called ../perl, other times .././perl + # and who knows if that list is exhaustive... + my ($dev0, $ino0) = stat 't/perl'; + my ($dev1, $ino1) = stat 'perl'; + unless (defined $dev0 && defined $dev1 && $dev0 == $dev1 && $ino0 == $ino1) { + undef $expected_file_found; + my $link = readlink $expected_file; + warn "'t/perl' => '$link', not 'perl'"; + die_255("Could not realink t/perl: $!") unless defined $link; + } +} if ($options{'test-build'}) { - report_and_exit($missing_target, 'could build', 'could not build', + report_and_exit(!$expected_file_found, 'could build', 'could not build', $real_target); -} elsif ($missing_target) { +} elsif (!$expected_file_found) { skip("could not build $real_target"); } -match_and_exit($real_target) if $match; +match_and_exit($real_target, @ARGV) if $match; if (defined $options{'one-liner'}) { my $exe = $target =~ /^(?:perl$|test)/ ? 'perl' : 'miniperl'; - unshift @ARGV, "./$exe", '-Ilib', '-e', $options{'one-liner'}; + unshift @ARGV, '-e', $options{'one-liner'}; + foreach (qw(c l w)) { + unshift @ARGV, "-$_" if $options{$_}; + } + unshift @ARGV, "./$exe", '-Ilib'; } # This is what we came here to run: @@ -789,12 +1174,12 @@ sub force_manifest { while (@parts) { $path .= '/' . shift @parts; next if -d $path; - mkdir $path, 0700 or die "Can't create $path: $!"; + mkdir $path, 0700 or die_255("Can't create $path: $!"); unshift @created_dirs, $path; } $fh = open_or_die($pathname, '>'); close_or_die($fh); - chmod 0, $pathname or die "Can't chmod 0 $pathname: $!"; + chmod 0, $pathname or die_255("Can't chmod 0 $pathname: $!"); } return \@missing, \@created_dirs; } @@ -820,10 +1205,10 @@ sub force_manifest_cleanup { push @errors, "Added file $file had sized changed by Configure to $size"; } - unlink $file or die "Can't unlink $file: $!"; + unlink $file or die_255("Can't unlink $file: $!"); } foreach my $dir (@$created_dirs) { - rmdir $dir or die "Can't rmdir $dir: $!"; + rmdir $dir or die_255("Can't rmdir $dir: $!"); } skip("@errors") if @errors; @@ -886,8 +1271,8 @@ EOPATCH my $mips = extract_from_file('Configure', qr!(''\) if (?:\./)?mips; then)!); # This is part of perl-5.001n. It's needed, to add -L/usr/local/lib to - # theld flags if libraries are found there. It shifts the code to set up - # libpth earlier, and then adds the code to add libpth entries to + # the ld flags if libraries are found there. It shifts the code to set + # up libpth earlier, and then adds the code to add libpth entries to # ldflags # mips was changed to ./mips in ecfc54246c2a6f42, perl5.000 patch.0g apply_patch(sprintf <<'EOPATCH', $mips); @@ -1088,13 +1473,13 @@ EOPATCH edit_file('Configure', sub { my $code = shift; $code =~ s/(optstr = ")([^"]+";\s*# getopt-style specification)/$1A:$2/ - or die "Substitution failed"; + or die_255("Substitution failed"); $code =~ s!^(: who configured the system)! touch posthint.sh . ./posthint.sh $1!ms - or die "Substitution failed"; + or die_255("Substitution failed"); return $code; }); apply_patch(<<'EOPATCH'); @@ -1170,6 +1555,19 @@ index 4b55fa6..60c3c64 100755 EOPATCH } + if ($major < 8 && $^O eq 'aix') { + edit_file('Configure', sub { + my $code = shift; + # Replicate commit a8c676c69574838b + # Whitespace allowed at the ends of /lib/syscalls.exp lines + # and half of commit c6912327ae30e6de + # AIX syscalls.exp scan: the syscall might be marked 32, 3264, or 64 + $code =~ s{(\bsed\b.*\bsyscall)(?:\[0-9\]\*)?(\$.*/lib/syscalls\.exp)} + {$1 . "[0-9]*[ \t]*" . $2}e; + return $code; + }); + } + if ($major < 8 && !extract_from_file('Configure', qr/^\t\tif test ! -t 0; then$/)) { # Before dfe9444ca7881e71, Configure would refuse to run if stdin was @@ -1240,7 +1638,7 @@ eval "$2=$tval"' EOC $code =~ s/\n: is a C symbol defined\?\n.*?\neval "\$2=\$tval"'\n\n/$fixed/sm - or die "substitution failed"; + or die_255("substitution failed"); return $code; }); } @@ -1328,6 +1726,15 @@ sub patch_hints { # to 5.002, lets just turn it off. $code =~ s/^useshrplib='true'/useshrplib='false'/m if $faking_it; + + # Part of commit d235852b65d51c44 + # Don't do this on a case sensitive HFS+ partition, as it + # breaks the build for 5.003 and earlier. + if ($case_insensitive + && $code !~ /^firstmakefile=GNUmakefile/) { + $code .= "\nfirstmakefile=GNUmakefile;\n"; + } + return $code; }); } @@ -1349,7 +1756,7 @@ case "$osvers" in cccdlflags="-DPIC -fPIC $cccdlflags" lddlflags="--whole-archive -shared $lddlflags" elif [ "`uname -m`" = "pmax" ]; then -# NetBSD 1.3 and 1.3.1 on pmax shipped an `old' ld.so, which will not work. +# NetBSD 1.3 and 1.3.1 on pmax shipped an 'old' ld.so, which will not work. d_dlopen=$undef elif [ -f /usr/libexec/ld.so ]; then d_dlopen=$define @@ -1491,7 +1898,7 @@ EOPATCH } elsif(!extract_from_file('hints/linux.sh', qr/^sparc-linux\)$/)) { my $fh = open_or_die('hints/linux.sh', '>>'); - print $fh <<'EOT' or die $!; + print $fh <<'EOT' or die_255($!); case "`uname -m`" in sparc*) @@ -1559,6 +1966,145 @@ index f61d0db..6097954 100644 EOPATCH } + + if ($major == 11) { + if (extract_from_file('patchlevel.h', + qr/^#include "unpushed\.h"/)) { + # I had thought it easier to detect when building one of the 52 + # commits with the original method of incorporating the git + # revision and drop parallel make flags. Commits shown by + # git log 46807d8e809cc127^..dcff826f70bf3f64^ ^d4fb0a1f15d1a1c4 + # However, it's not actually possible to make miniperl for that + # configuration as-is, because the file .patchnum is only made + # as a side effect of target 'all' + # I also don't think that it's "safe" to simply run + # make_patchnum.sh before the build. We need the proper + # dependency rules in the Makefile to *stop* it being run again + # at the wrong time. + # This range is important because contains the commit that + # merges Schwern's y2038 work. + apply_patch(<<'EOPATCH'); +diff --git a/Makefile.SH b/Makefile.SH +index 9ad8b6f..106e721 100644 +--- a/Makefile.SH ++++ b/Makefile.SH +@@ -540,9 +544,14 @@ sperl.i: perl.c $(h) + + .PHONY: all translators utilities make_patchnum + +-make_patchnum: ++make_patchnum: lib/Config_git.pl ++ ++lib/Config_git.pl: make_patchnum.sh + sh $(shellflags) make_patchnum.sh + ++# .patchnum, unpushed.h and lib/Config_git.pl are built by make_patchnum.sh ++unpushed.h .patchnum: lib/Config_git.pl ++ + # make sure that we recompile perl.c if .patchnum changes + perl$(OBJ_EXT): .patchnum unpushed.h + +EOPATCH + } elsif (-f '.gitignore' + && extract_from_file('.gitignore', qr/^\.patchnum$/)) { + # 8565263ab8a47cda to 46807d8e809cc127^ inclusive. + edit_file('Makefile.SH', sub { + my $code = shift; + $code =~ s/^make_patchnum:\n/make_patchnum: .patchnum + +.sha1: .patchnum + +.patchnum: make_patchnum.sh +/m; + return $code; + }); + } elsif (-f 'lib/.gitignore' + && extract_from_file('lib/.gitignore', + qr!^/Config_git.pl!) + && !extract_from_file('Makefile.SH', + qr/^uudmap\.h.*:bitcount.h$/)) { + # Between commits and dcff826f70bf3f64 and 0f13ebd5d71f8177^ + edit_file('Makefile.SH', sub { + my $code = shift; + # Bug introduced by 344af494c35a9f0f + # fixed in 0f13ebd5d71f8177 + $code =~ s{^(pod/perlapi\.pod) (pod/perlintern\.pod): } + {$1: $2\n\n$2: }m; + # Bug introduced by efa50c51e3301a2c + # fixed in 0f13ebd5d71f8177 + $code =~ s{^(uudmap\.h) (bitcount\.h): } + {$1: $2\n\n$2: }m; + + # The rats nest of getting git_version.h correct + + if ($code =~ s{git_version\.h: stock_git_version\.h +\tcp stock_git_version\.h git_version\.h} + {}m) { + # before 486cd780047ff224 + + # We probably can't build between + # 953f6acfa20ec275^ and 8565263ab8a47cda + # inclusive, but all commits in that range + # relate to getting make_patchnum.sh working, + # so it is extremely unlikely to be an + # interesting bisect target. They will skip. + + # No, don't spawn a submake if + # make_patchnum.sh or make_patchnum.pl fails + $code =~ s{\|\| \$\(MAKE\) miniperl.*} + {}m; + $code =~ s{^\t(sh.*make_patchnum\.sh.*)} + {\t-$1}m; + + # Use an external perl to run make_patchnum.pl + # because miniperl still depends on + # git_version.h + $code =~ s{^\t.*make_patchnum\.pl} + {\t-$^X make_patchnum.pl}m; + + + # "Truth in advertising" - running + # make_patchnum generates 2 files. + $code =~ s{^make_patchnum:.*}{ +make_patchnum: lib/Config_git.pl + +git_version.h: lib/Config_git.pl + +perlmini\$(OBJ_EXT): git_version.h + +lib/Config_git.pl:}m; + } + # Right, now we've corrected Makefile.SH to + # correctly describe how lib/Config_git.pl and + # git_version.h are made, we need to fix the rest + + # This emulates commit 2b63e250843b907e + # This might duplicate the rule stating that + # git_version.h depends on lib/Config_git.pl + # This is harmless. + $code =~ s{^(?:lib/Config_git\.pl )?git_version\.h: (.* make_patchnum\.pl.*)} + {git_version.h: lib/Config_git.pl + +lib/Config_git.pl: $1}m; + + # This emulates commits 0f13ebd5d71f8177 and + # and a04d4598adc57886. It ensures that + # lib/Config_git.pl is built before configpm, + # and that configpm is run exactly once. + $code =~ s{^(\$\(.*?\) )?(\$\(CONFIGPOD\))(: .*? configpm Porting/Glossary)( lib/Config_git\.pl)?}{ + # If present, other files depend on $(CONFIGPOD) + ($1 ? "$1: $2\n\n" : '') + # Then the rule we found + . $2 . $3 + # Add dependency if not there + . ($4 ? $4 : ' lib/Config_git.pl') + }me; + + return $code; + }); + } + } + if ($major < 14) { # Commits dc0655f797469c47 and d11a62fe01f2ecb2 edit_file('Makefile.SH', sub { @@ -1597,6 +2143,21 @@ $2!; } } + if ($^O eq 'aix' && $major >= 11 && $major <= 15 + && extract_from_file('makedef.pl', qr/^use Config/)) { + edit_file('Makefile.SH', sub { + # The AIX part of commit e6807d8ab22b761c + # It's safe to substitute lib/Config.pm for config.sh + # as lib/Config.pm depends on config.sh + # If the tree is post e6807d8ab22b761c, the substitution + # won't match, which is harmless. + my $code = shift; + $code =~ s{^(perl\.exp:.* )config\.sh(\b.*)} + {$1 . '$(CONFIGPM)' . $2}me; + return $code; + }); + } + # 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 @@ -1861,6 +2422,26 @@ EOPATCH } } + if ($major < 4 && $^O eq 'hpux' + && extract_from_file('sv.c', qr/i = _filbuf\(/)) { + apply_patch(<<'EOPATCH'); +diff --git a/sv.c b/sv.c +index a1f1d60..0a806f1 100644 +--- a/sv.c ++++ b/sv.c +@@ -2641,7 +2641,7 @@ I32 append; + + FILE_cnt(fp) = cnt; /* deregisterize cnt and ptr */ + FILE_ptr(fp) = ptr; +- i = _filbuf(fp); /* get more characters */ ++ i = __filbuf(fp); /* get more characters */ + cnt = FILE_cnt(fp); + ptr = FILE_ptr(fp); /* reregisterize cnt and ptr */ + + +EOPATCH + } + if ($major == 4 && extract_from_file('scope.c', qr/\(SV\*\)SSPOPINT/)) { # [PATCH] 5.004_04 +MAINT_TRIAL_1 broken when sizeof(int) != sizeof(void) # Fixes a bug introduced in 161b7d1635bc830b @@ -1872,9 +2453,13 @@ EOPATCH apply_commit('e1c148c28bf3335b', 'av.c'); } - if ($major == 4 && !extract_from_file('perl.c', qr/delimcpy.*,$/)) { - # bug introduced in 2a92aaa05aa1acbf, fixed in 8490252049bf42d3 - apply_patch(<<'EOPATCH'); + if ($major == 4) { + my $rest = extract_from_file('perl.c', qr/delimcpy(.*)/); + if (defined $rest and $rest !~ /,$/) { + # delimcpy added in fc36a67e8855d031, perl.c refactored to use it. + # bug introduced in 2a92aaa05aa1acbf, fixed in 8490252049bf42d3 + # code then moved to util.c in commit 491527d0220de34e + apply_patch(<<'EOPATCH'); diff --git a/perl.c b/perl.c index 4eb69e3..54bbb00 100644 --- a/perl.c @@ -1889,6 +2474,7 @@ index 4eb69e3..54bbb00 100644 &len); #endif /* ! (atarist || DOSISH) */ EOPATCH + } } if ($major == 4 && $^O eq 'linux') { @@ -1990,6 +2576,207 @@ EOPATCH }); } + if ($major < 5 && $^O eq 'aix' + && !extract_from_file('pp_sys.c', + qr/defined\(HOST_NOT_FOUND\) && !defined\(h_errno\)/)) { + # part of commit dc45a647708b6c54 + # Andy Dougherty's configuration patches (Config_63-01 up to 04). + apply_patch(<<'EOPATCH') +diff --git a/pp_sys.c b/pp_sys.c +index c2fcb6f..efa39fb 100644 +--- a/pp_sys.c ++++ b/pp_sys.c +@@ -54,7 +54,7 @@ extern "C" int syscall(unsigned long,...); + #endif + #endif + +-#ifdef HOST_NOT_FOUND ++#if defined(HOST_NOT_FOUND) && !defined(h_errno) + extern int h_errno; + #endif + +EOPATCH + } + + if ($major == 5 + && `git rev-parse HEAD` eq "22c35a8c2392967a5ba6b5370695be464bd7012c\n") { + # Commit 22c35a8c2392967a is significant, + # "phase 1 of somewhat major rearrangement of PERL_OBJECT stuff" + # but doesn't build due to 2 simple errors. blead in this broken state + # was merged to the cfgperl branch, and then these were immediately + # corrected there. cfgperl (with the fixes) was merged back to blead. + # The resultant rather twisty maze of commits looks like this: + +=begin comment + +* | | commit 137225782c183172f360c827424b9b9f8adbef0e +|\ \ \ Merge: 22c35a8 2a8ee23 +| |/ / Author: Gurusamy Sarathy +| | | Date: Fri Oct 30 17:38:36 1998 +0000 +| | | +| | | integrate cfgperl tweaks into mainline +| | | +| | | p4raw-id: //depot/perl@2144 +| | | +| * | commit 2a8ee23279873759693fa83eca279355db2b665c +| | | Author: Jarkko Hietaniemi +| | | Date: Fri Oct 30 13:27:39 1998 +0000 +| | | +| | | There can be multiple yacc/bison errors. +| | | +| | | p4raw-id: //depot/cfgperl@2143 +| | | +| * | commit 93fb2ac393172fc3e2c14edb20b718309198abbc +| | | Author: Jarkko Hietaniemi +| | | Date: Fri Oct 30 13:18:43 1998 +0000 +| | | +| | | README.posix-bc update. +| | | +| | | p4raw-id: //depot/cfgperl@2142 +| | | +| * | commit 4ec43091e8e6657cb260b5e563df30aaa154effe +| | | Author: Jarkko Hietaniemi +| | | Date: Fri Oct 30 09:12:59 1998 +0000 +| | | +| | | #2133 fallout. +| | | +| | | p4raw-id: //depot/cfgperl@2141 +| | | +| * | commit 134ca994cfefe0f613d43505a885e4fc2100b05c +| |\ \ Merge: 7093112 22c35a8 +| |/ / Author: Jarkko Hietaniemi +|/| | Date: Fri Oct 30 08:43:18 1998 +0000 +| | | +| | | Integrate from mainperl. +| | | +| | | p4raw-id: //depot/cfgperl@2140 +| | | +* | | commit 22c35a8c2392967a5ba6b5370695be464bd7012c +| | | Author: Gurusamy Sarathy +| | | Date: Fri Oct 30 02:51:39 1998 +0000 +| | | +| | | phase 1 of somewhat major rearrangement of PERL_OBJECT stuff +| | | (objpp.h is gone, embed.pl now does some of that); objXSUB.h +| | | should soon be automated also; the global variables that +| | | escaped the PL_foo conversion are now reined in; renamed +| | | MAGIC in regcomp.h to REG_MAGIC to avoid collision with the +| | | type of same name; duplicated lists of pp_things in various +| | | places is now gone; result has only been tested on win32 +| | | +| | | p4raw-id: //depot/perl@2133 + +=end comment + +=cut + + # and completely confuses git bisect (and at least me), causing it to + # the bisect run to confidently return the wrong answer, an unrelated + # commit on the cfgperl branch. + + apply_commit('4ec43091e8e6657c'); + } + + if ($major == 5 + && extract_from_file('pp_sys.c', qr/PERL_EFF_ACCESS_R_OK/) + && !extract_from_file('pp_sys.c', qr/XXX Configure test needed for eaccess/)) { + # Between 5ff3f7a4e03a6b10 and c955f1177b2e311d^ + # This is the meat of commit c955f1177b2e311d (without the other + # indenting changes that would cause a conflict). + # Without this 538 revisions won't build on (at least) Linux + apply_patch(<<'EOPATCH'); +diff --git a/pp_sys.c b/pp_sys.c +index d60c8dc..867dee4 100644 +--- a/pp_sys.c ++++ b/pp_sys.c +@@ -198,9 +198,18 @@ static char zero_but_true[ZBTLEN + 1] = "0 but true"; + # if defined(I_SYS_SECURITY) + # include + # endif +-# define PERL_EFF_ACCESS_R_OK(p) (eaccess((p), R_OK, ACC_SELF)) +-# define PERL_EFF_ACCESS_W_OK(p) (eaccess((p), W_OK, ACC_SELF)) +-# define PERL_EFF_ACCESS_X_OK(p) (eaccess((p), X_OK, ACC_SELF)) ++ /* XXX Configure test needed for eaccess */ ++# ifdef ACC_SELF ++ /* HP SecureWare */ ++# define PERL_EFF_ACCESS_R_OK(p) (eaccess((p), R_OK, ACC_SELF)) ++# define PERL_EFF_ACCESS_W_OK(p) (eaccess((p), W_OK, ACC_SELF)) ++# define PERL_EFF_ACCESS_X_OK(p) (eaccess((p), X_OK, ACC_SELF)) ++# else ++ /* SCO */ ++# define PERL_EFF_ACCESS_R_OK(p) (eaccess((p), R_OK)) ++# define PERL_EFF_ACCESS_W_OK(p) (eaccess((p), W_OK)) ++# define PERL_EFF_ACCESS_X_OK(p) (eaccess((p), X_OK)) ++# endif + #endif + + #if !defined(PERL_EFF_ACCESS_R_OK) && defined(HAS_ACCESSX) && defined(ACC_SELF) +EOPATCH + } + + if ($major == 5 + && extract_from_file('mg.c', qr/If we're still on top of the stack, pop us off/) + && !extract_from_file('mg.c', qr/PL_savestack_ix -= popval/)) { + # Fix up commit 455ece5e082708b1: + # SSNEW() API for allocating memory on the savestack + # Message-Id: + # Subject: [PATCH 5.005_51] (was: why SAVEDESTRUCTOR()...) + apply_commit('3c8a44569607336e', 'mg.c'); + } + + if ($major == 5) { + if (extract_from_file('doop.c', qr/croak\(no_modify\);/) + && extract_from_file('doop.c', qr/croak\(PL_no_modify\);/)) { + # Whilst the log suggests that this would only fix 5 commits, in + # practice this area of history is a complete tarpit, and git bisect + # gets very confused by the skips in the middle of the back and + # forth merging between //depot/perl and //depot/cfgperl + apply_commit('6393042b638dafd3'); + } + + # One error "fixed" with another: + if (extract_from_file('pp_ctl.c', + qr/\Qstatic void *docatch_body _((void *o));\E/)) { + apply_commit('5b51e982882955fe'); + } + # Which is then fixed by this: + if (extract_from_file('pp_ctl.c', + qr/\Qstatic void *docatch_body _((valist\E/)) { + apply_commit('47aa779ee4c1a50e'); + } + + if (extract_from_file('thrdvar.h', qr/PERLVARI\(Tprotect/) + && !extract_from_file('embedvar.h', qr/PL_protect/)) { + # Commit 312caa8e97f1c7ee didn't update embedvar.h + apply_commit('e0284a306d2de082', 'embedvar.h'); + } + } + + if ($major == 5 + && extract_from_file('sv.c', + qr/PerlDir_close\(IoDIRP\((?:\(IO\*\))?sv\)\);/) + && !(extract_from_file('toke.c', + qr/\QIoDIRP(FILTER_DATA(AvFILLp(PL_rsfp_filters))) = NULL\E/) + || extract_from_file('toke.c', + qr/\QIoDIRP(datasv) = (DIR*)NULL;\E/))) { + # Commit 93578b34124e8a3b, //depot/perl@3298 + # close directory handles properly when localized, + # tweaked slightly by commit 1236053a2c722e2b, + # add test case for change#3298 + # + # The fix is the last part of: + # + # various fixes for clean build and test on win32; configpm broken, + # needed to open myconfig.SH rather than myconfig; sundry adjustments + # to bytecode stuff; tweaks to DYNAMIC_ENV_FETCH code to make it + # work under win32; getenv_sv() changed to getenv_len() since SVs + # aren't visible in the lower echelons; remove bogus exports from + # config.sym; PERL_OBJECT-ness for C++ exception support; null out + # IoDIRP in filter_del() or sv_free() will attempt to close it + # + # The changed code is modified subsequently by commit e0c198038146b7a4 + apply_commit('a6c403648ecd5cc7', 'toke.c'); + } + if ($major < 6 && $^O eq 'netbsd' && !extract_from_file('unixish.h', qr/defined\(NSIG\).*defined\(__NetBSD__\)/)) { @@ -2103,6 +2890,16 @@ sub patch_ext { apply_commit('6695a346c41138df'); } + if (-f 'ext/Hash/Util/Makefile.PL' + && extract_from_file('ext/Hash/Util/Makefile.PL', + qr/\bDIR\b.*'FieldHash'/)) { + # ext/Hash/Util/Makefile.PL should not recurse to FieldHash's Makefile.PL + # *nix, VMS and Win32 all know how to (and have to) call the latter directly. + # As is, targets in ext/Hash/Util/FieldHash get called twice, which may result + # in race conditions, and certainly messes up make clean; make distclean; + apply_commit('550428fe486b1888'); + } + if ($major < 8 && $^O eq 'darwin' && !-f 'ext/DynaLoader/dl_dyld.xs') { checkout_file('ext/DynaLoader/dl_dyld.xs', 'f556e5b971932902'); apply_patch(<<'EOPATCH');