In perl.git, the branch nicholas/bisect has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/a7cf1a78057f266b94755cd4f8d1d45c710ed3d4?hp=35c5736572cfe7a326c2bcdd39a98c514d54d038>
- Log -----------------------------------------------------------------
commit a7cf1a78057f266b94755cd4f8d1d45c710ed3d4
Author: Nicholas Clark <n...@ccl4.org>
Date: Mon Apr 9 15:14:32 2012 +0200
Add --early-fixup and --late-fixup to bisect.pl, for user-controlled
patching.
These provide a way to run code or to conditionally or unconditionally
apply patches for each revision tested during git bisect. This is very
useful when for the commit range, operating system and configuration options
tested, the behaviour otherwise would be to fail to build for a wide range
of revisions, and hence the bisect would finish without finding culprit
commit due to getting bogged down in 'skipped' revisions.
M Porting/bisect-runner.pl
commit 6674e533dbfbcab168065f4fa6da89693f94acf1
Author: Nicholas Clark <n...@ccl4.org>
Date: Mon Apr 9 11:04:37 2012 +0200
Add --all-fixups to bisect.pl, to apply all patches and fixups.
bisect-runner.pl 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 - .SH files aren't patched until after
Configure is run, and C and XS code isn't patched until after miniperl is
built. If --all-fixups is specified, all the fixups are done before running
Configure.
M Porting/bisect-runner.pl
commit 2b77752d6aa1b628f9e0df21af66678dd9651ce9
Author: Nicholas Clark <n...@ccl4.org>
Date: Mon Apr 9 10:18:34 2012 +0200
bisect-runner.pl should always exit fatally with 255, to abort the bisect.
Don't use die or croak, as these will exit with the value of $! or $?
instead
of 255, and git bisect doesn't treat these as fatal errors, but ploughs on
before inevitably failing messily for some other reason, concealing the true
error message.
M Porting/bisect-runner.pl
commit f8920ebe16177aec03e09ee3560be17e5180ecbc
Author: Nicholas Clark <n...@ccl4.org>
Date: Mon Apr 9 11:31:25 2012 +0200
In bisect-runner.pl, refactor the system ... and die; into system_or_die().
M Porting/bisect-runner.pl
commit f0aadfe7a57aa72ac1290ba0509bfb45ec589543
Author: Nicholas Clark <n...@ccl4.org>
Date: Mon Apr 9 09:25:09 2012 +0200
When testing the end version, bisect.pl should treat a 'skip' as fatal.
git bisect uses exit code 125 to signal a skip. Previously bisect.pl would
treat 125 just like every other non-zero exit code, assume that it meant
'fail', and if 'fail' was expected for the end version then it would start
the bisect run as normal. Which isn't useful, as it means that there's a
problem with the user's test case.
M Porting/bisect.pl
commit 7ce57b0d758991c4dac4a4f2f22a9712c4bbed60
Author: Nicholas Clark <n...@ccl4.org>
Date: Mon Apr 9 09:14:21 2012 +0200
bisect-runner.pl should search for lib*.a as well as lib*.so
When forcing the library list on earlier perls to avoid versioned shared
objects, also look for static libraries. Also, ensure bisect-runner.pl
searches additional library paths given to it via -Alibpth
Without this, one can't test build against static libraries in non-standard
locations.
M Porting/bisect-runner.pl
commit a7b6df488cef8c941ca8877a1eda4239e37377f1
Author: Nicholas Clark <n...@ccl4.org>
Date: Mon Apr 9 08:38:08 2012 +0200
bisect-runner.pl should use ".$Config{dlext}" instead of hard-coding ".so".
M Porting/bisect-runner.pl
commit 827ce1e0aba41d9d982fafa378dc734d14f38596
Author: Nicholas Clark <n...@ccl4.org>
Date: Mon Apr 9 08:05:16 2012 +0200
Teach bisect-runner.pl that on HP-UX, _filbuf() is named __filbuf().
This is all that is needed to build 5.003 and earlier. bisect.pl can
validate
all stable versions from blead back to 5.002
M Porting/bisect-runner.pl
commit 1794d3ecdb0d71366353bf2f218a806b71d3abc9
Author: Nicholas Clark <n...@ccl4.org>
Date: Mon Apr 9 08:02:38 2012 +0200
bisect-runner.pl needs to know how to identify HP-UX's patch.
Unlike AIX, HP-UX patch offers no meaningful clue as to its upstream
version:
$ patch -v
$Header: patch.c,v 76.1.1.2.1.3 2001/12/03 12:24:52 abhinav Exp $
Patch level: 0
But it ignores unified diffs, so assume the worst and feed it context diffs.
M Porting/bisect-runner.pl
commit 6f66d801c65596c8c7e61f9f31022ebd1959557e
Author: Nicholas Clark <n...@ccl4.org>
Date: Tue Apr 10 15:18:03 2012 +0200
On HP-UX, bisect without any -j option as the system make is "special".
HP-UX system make offers parallelism with -P not -j. (But doesn't deliver on
it, so we're not going to attempt to work round its crankiness and
failings.)
M Porting/bisect-runner.pl
M Porting/bisect.pl
commit 0697c05a41b18892e800bd263e9e2569a53897e6
Author: Nicholas Clark <n...@ccl4.org>
Date: Tue Apr 10 10:37:41 2012 +0200
In bisect{,-runner}.pl, refactor the code for CPU probing and make jobs.
Move the code that attempts various ways to probe for the number of CPUs
from bisect-runner.pl to bisect.pl. Skip the probe entirely if a -j (--jobs)
options is passed to bisect.pl. For --jobs=0 (or -j0) entirely skip adding
-j to the make command line. (For heretical versions of make which don't use
-j for parallelism).
Previously the probe code always ran for each call to bisect-runner.pl,
which is completely redundant if bisect-runner.pl is being called for
argument validation or help text, and inefficient even when building, as the
number of CPUs rarely changes during a bisect run. Additionally there was no
way to avoid a -j in the make command line, which isn't going to fly on
systems where the make utility doesn't have a -j option.
M Porting/bisect-runner.pl
M Porting/bisect.pl
-----------------------------------------------------------------------
Summary of changes:
Porting/bisect-runner.pl | 311 ++++++++++++++++++++++++++++++++++++----------
Porting/bisect.pl | 25 ++++-
2 files changed, 270 insertions(+), 66 deletions(-)
diff --git a/Porting/bisect-runner.pl b/Porting/bisect-runner.pl
index ea1534b..5619089 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
);
@@ -66,6 +53,7 @@ unless(GetOptions(\%options,
$options{'expect-pass'} = 0;
},
'force-manifest', 'force-regen', 'test-build', 'validate',
+ 'all-fixups', 'early-fixup=s@', 'late-fixup=s@',
'check-args', 'check-shebang!', 'usage|help|?', 'A=s@',
'D=s@' => sub {
my (undef, $val) = @_;
@@ -82,7 +70,7 @@ 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;
@@ -350,10 +338,11 @@ to use F<gmake> in place of the system F<make>.
-j I<jobs>
-Number of C<make> jobs to run in parallel. If F</proc/cpuinfo> exists and
-can be parsed, or F</sbin/sysctl> exists and reports C<hw.ncpu>, or
-F</usr/bin/getconf> exists and reports C<_NPROCESSORS_ONLN> defaults to 1 +
-I<number of CPUs>. Otherwise defaults to 2.
+Number of C<make> jobs to run in parallel. A value of 0 suppresses
+parallelism. If F</proc/cpuinfo> exists and can be parsed, or F</sbin/sysctl>
+exists and reports C<hw.ncpu>, or F</usr/bin/getconf> exists and reports
+C<_NPROCESSORS_ONLN> defaults to 1 + I<number of CPUs>. On HP-UX with the
+system make defaults to 0, otherwise defaults to 2.
=item *
@@ -453,6 +442,77 @@ C<--expect-pass=0> is equivalent to C<--expect-fail>. I<1>
is the default.
=item *
+--all-fixups
+
+F<bisect-runner.pl> 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<Configure> is run, and C<C> and C<XS> code isn't patched until after
+F<miniperl> is built. If C<--all-fixups> is specified, all the fixups are
+done before running C<Configure>. 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 I<skip>ed. If this happens,
+please report it as a bug, giving the OS and problem revision.
+
+=item *
+
+--early-fixup file
+
+=item *
+
+--late-fixup file
+
+Specify a file containing a patch or other fixup for the source code. The
+action to take depends on the first line of the fixup file
+
+=over 4
+
+=item *
+
+C<#!perl>
+
+If the first line starts C<#!perl> then the file is run using C<$^X>
+
+=item *
+
+C<#!/absolute/path>
+
+If a shebang line is present the file is executed using C<system>
+
+=item *
+
+C<I<filename> =~ /I<pattern>/>
+
+=item *
+
+C<I<filename> !~ /I<pattern>/>
+
+If I<filename> does not exist then the fixup file's contents are ignored.
+Otherwise, for C<=~>, if it contains a line matching I<pattern>, then the
+file is fed to C<patch -p1> on standard input. For C<=~>, the patch is
+applied if no lines match the pattern.
+
+As the empty pattern in Perl is a special case (it matches the most recent
+sucessful match) which is not useful here, an the treatment of empty pattern
+is special-cased. C<I<filename> =~ //> applies the patch if filename is
+present. C<I<filename> !~ //> applies the patch if filename missing. This
+makes it easy to unconditionally apply patches to files, and to use a patch
+as a way of creating a new file.
+
+=item *
+
+Otherwise, the file is assumed to be a patch, and always applied.
+
+=back
+
+I<early-fixup>s are applied before F<./Configure> is run. I<late-fixup>s are
+applied just after F<./Configure> is run.
+
+These options can be specified more than once. I<file> is actually expanded
+as a glob pattern. Globs that do not match are errors, as are missing files.
+
+=item *
+
--no-clean
Tell F<bisect-runner.pl> not to clean up after the build. This allows one
@@ -515,8 +575,45 @@ 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;
+}
+
+sub die_255 {
+ croak_255(@_);
+}
+die_255("$0: Can't build $target")
+ if defined $target && !grep {@targets} $target;
+
+foreach my $phase (qw(early late)) {
+ next unless $options{"$phase-fixup"};
+ my $bail_out;
+ require File::Glob;
+ my @expanded;
+ foreach my $glob (@{$options{"$phase-fixup"}}) {
+ my @got = File::Glob::bsd_glob($glob);
+ push @expanded, @got ? @got : $glob;
+ }
+ @expanded = sort @expanded;
+ $options{"$phase-fixup"} = \@expanded;
+ foreach (@expanded) {
+ unless (-f $_) {
+ print STDERR "$phase-fixup '$_' is not a readable file\n";
+ ++$bail_out;
+ }
+ }
+ exit 255 if $bail_out;
+}
+
unless (exists $defines{cc}) {
# If it fails, the heuristic of 63f9ec3008baf7d6 is noisy, and hence
# confusing.
@@ -526,7 +623,7 @@ unless (exists $defines{cc}) {
$defines{cc} = (`ccache -V`, $?) ? 'cc' : 'ccache cc';
}
-$j = "-j$j" if $j =~ /\A\d+\z/;
+my $j = $options{jobs} ? "-j$options{jobs}" : '';
if (exists $options{make}) {
if (!exists $defines{make}) {
@@ -544,7 +641,7 @@ if (exists $options{make}) {
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;
}
@@ -552,8 +649,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 = '</dev/null ' . shift;
+ system($command) and croak_255("'$command' failed, \$!=$!, \$?=$?");
}
sub extract_from_file {
@@ -573,11 +675,11 @@ sub edit_file {
local $/;
my $fh = open_or_die($file);
my $orig = <$fh>;
- 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);
}
@@ -614,7 +716,7 @@ sub ud2cd {
}
if (!length $diff_in) {
- die "That didn't seem to be a diff";
+ die_255("That didn't seem to be a diff");
}
if ($diff_in =~ /\A\*\*\* /ms) {
@@ -634,11 +736,11 @@ sub ud2cd {
}
$diff_in =~ s/\A([^\n]+\n?)//ms;
my $line = $1;
- die "Can't parse '$line'" unless $line =~ s/\A--- /*** /ms;
+ die_255("Can't parse '$line'") unless $line =~ s/\A--- /*** /ms;
$diff_out .= $line;
$diff_in =~ s/\A([^\n]+\n?)//ms;
$line = $1;
- die "Can't parse '$line'" unless $line =~ s/\A\+\+\+ /--- /ms;
+ die_255("Can't parse '$line'") unless $line =~ s/\A\+\+\+ /--- /ms;
$diff_out .= $line;
# Loop for hunks
@@ -651,7 +753,8 @@ sub ud2cd {
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 "Confused in $hunk" unless $diff_in =~ s/\A([^\n]*)\n//ms;
+ die_255("Confused in $hunk")
+ unless $diff_in =~ s/\A([^\n]*)\n//ms;
my $line = $1;
$line = ' ' unless length $line;
if ($line =~ /^ .*/) {
@@ -670,14 +773,14 @@ sub ud2cd {
push @$add, $1;
--$to_count;
} else {
- die "Can't parse '$line' as part of hunk $hunk";
+ die_255("Can't parse '$line' as part of hunk $hunk");
}
}
process_hunk(\$from_out, \$to_out, \$has_from, \$has_to,
$delete, $add);
- die "No lines in hunk $hunk"
+ die_255("No lines in hunk $hunk")
unless length $from_out || length $to_out;
- die "No changes in hunk $hunk"
+ die_255("No changes in hunk $hunk")
unless $has_from || $has_to;
$diff_out .= "***************\n";
$diff_out .= "*** $from_start,$from_end ****\n";
@@ -696,7 +799,7 @@ sub ud2cd {
if (!defined $use_context) {
my $version = `patch -v 2>&1`;
- die "Can't run `patch -v`, \$?=$?, bailing out"
+ die_255("Can't run `patch -v`, \$?=$?, bailing out")
unless defined $version;
if ($version =~ /Free Software Foundation/) {
$use_context = 0;
@@ -704,6 +807,10 @@ sub ud2cd {
# 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;
@@ -722,21 +829,21 @@ sub apply_patch {
$files = " $1";
}
my $patch_to_use = placate_patch_prog($patch);
- open my $fh, '|-', 'patch', '-p1' or die "Can't run 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";
print STDERR "\nConverted to a context diff
<<'EOCONTEXT'\n${patch_to_use}EOCONTEXT\n"
if $patch_to_use ne $patch;
- die "Can't $what$files: $?, $!";
+ die_255("Can't $what$files: $?, $!");
}
sub apply_commit {
my ($commit, @files) = @_;
my $patch = `git show $commit @files`;
if (!defined $patch) {
- die "Can't get commit $commit for @files: $?" if @files;
- die "Can't get commit $commit: $?";
+ 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" : '');
}
@@ -745,8 +852,8 @@ sub revert_commit {
my ($commit, @files) = @_;
my $patch = `git show -R $commit @files`;
if (!defined $patch) {
- die "Can't get revert commit $commit for @files: $?" if @files;
- die "Can't get revert commit $commit: $?";
+ 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" : '');
}
@@ -755,22 +862,22 @@ sub checkout_file {
my ($file, $commit) = @_;
$commit ||= 'blead';
system "git show $commit:$file > $file </dev/null"
- and die "Could not extract $file at revision $commit";
+ and die_255("Could not extract $file at revision $commit");
}
sub check_shebang {
my $file = shift;
return unless -e $file;
if (!-x $file) {
- die "$file is not executable.
+ die_255("$file is not executable.
system($file, ...) is always going to fail.
-Bailing out";
+Bailing out");
}
my $fh = open_or_die($file);
my $line = <$fh>;
return unless $line =~ m{\A#!(/\S+/perl\S*)\s};
- die "$file will always be run by $1
+ 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
@@ -785,7 +892,7 @@ test case to
[You may also need to add -- before ./perl to prevent that -Ilib as being
parsed as an argument to bisect.pl]
-Bailing out";
+Bailing out");
}
sub clean {
@@ -863,7 +970,7 @@ sub match_and_exit {
}
# Not going to assume that system perl is yet new enough to have autodie
-system 'git clean -dxf </dev/null' and die;
+system_or_die('git clean -dxf');
if (!defined $target) {
match_and_exit(undef, @ARGV) if $match;
@@ -876,7 +983,7 @@ skip('no Configure - is this the //depot/perlext/Compiler
branch?')
my $case_insensitive;
{
my ($dev_C, $ino_C) = stat 'Configure';
- die "Could not stat Configure: $!" unless defined $dev_C;
+ die_255("Could not stat Configure: $!") unless defined $dev_C;
my ($dev_c, $ino_c) = stat 'configure';
++$case_insensitive
if defined $dev_c && $dev_C == $dev_c && $ino_C == $ino_c;
@@ -890,6 +997,12 @@ my $major
patch_Configure();
patch_hints();
+if ($options{'all-fixups'}) {
+ patch_SH();
+ patch_C();
+ patch_ext();
+}
+apply_fixups($options{'early-fixup'});
# if Encode is not needed for the test, you can speed up the bisect by
# excluding it from the runs with -Dnoextensions=Encode
@@ -906,6 +1019,10 @@ patch_hints();
# bail out pretty early on. Configure won't let us override libswanted, but it
# will let us override the entire libs list.
+foreach (@{$options{A}}) {
+ push @paths, $1 if /^libpth=(.*)/s;
+}
+
unless (extract_from_file('Configure', 'ignore_versioned_solibs')) {
# Before 1cfa4ec74d4933da, so force the libs list.
@@ -915,7 +1032,9 @@ unless (extract_from_file('Configure',
'ignore_versioned_solibs')) {
foreach my $lib (qw(sfio socket inet nsl nm ndbm gdbm dbm db malloc dl dld
ld sun m crypt sec util c cposix posix ucb BSD)) {
foreach my $dir (@paths) {
- next unless -f "$dir/lib$lib.so";
+ # Note the wonderful consistency of dot-or-not in the config vars:
+ next unless -f "$dir/lib$lib.$Config{dlext}"
+ || -f "$dir/lib$lib$Config{lib_ext}";
push @libs, "-l$lib";
last;
}
@@ -949,25 +1068,27 @@ push @ARGS, map {"-A$_"} @{$options{A}};
# </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;
+die_255("Can't fork: $!") unless defined $pid;
if (!$pid) {
open STDIN, '<', '/dev/null';
# 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 exits immediately and the check for config.sh below will skip.
+ no warnings; # Don't tell me "statement unlikely to be reached". I know.
exec './Configure', @ARGS;
- die "Failed to start Configure: $!";
+ die_255("Failed to start Configure: $!");
}
waitpid $pid, 0
- or die "wait for Configure, pid $pid failed: $!";
+ or die_255("wait for Configure, pid $pid failed: $!");
-patch_SH();
+patch_SH() unless $options{'all-fixups'};
+apply_fixups($options{'late-fixup'});
if (-f 'config.sh') {
# Emulate noextensions if Configure doesn't support it.
fake_noextensions()
if $major < 10 && $defines{noextensions};
- system './Configure -S </dev/null' and die;
+ system_or_die('./Configure -S');
}
if ($target =~ /config\.s?h/) {
@@ -992,12 +1113,13 @@ if($options{'force-regen'}
&& extract_from_file('Makefile', qr/\bregen_headers\b/)) {
# regen_headers was added in e50aee73b3d4c555, patch.1m for perl5.001
# It's not worth faking it for earlier revisions.
- system "make regen_headers </dev/null"
- and die;
+ system_or_die('make regen_headers');
}
-patch_C();
-patch_ext();
+unless ($options{'all-fixups'}) {
+ patch_C();
+ patch_ext();
+}
# Parallel build for miniperl is safe
system "$options{make} $j miniperl </dev/null";
@@ -1043,7 +1165,7 @@ if ($expected_file_found && $expected_file eq 't/perl') {
undef $expected_file_found;
my $link = readlink $expected_file;
warn "'t/perl' => '$link', not 'perl'";
- die "Could not realink t/perl: $!" unless defined $link;
+ die_255("Could not realink t/perl: $!") unless defined $link;
}
}
@@ -1121,12 +1243,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;
}
@@ -1152,10 +1274,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;
@@ -1420,13 +1542,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');
@@ -1585,7 +1707,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;
});
}
@@ -1845,7 +1967,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*)
@@ -2369,6 +2491,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
@@ -2992,6 +3134,45 @@ EOFIX
}
}
+sub apply_fixups {
+ my $fixups = shift;
+ return unless $fixups;
+ foreach my $file (@$fixups) {
+ my $fh = open_or_die($file);
+ my $line = <$fh>;
+ close_or_die($fh);
+ if ($line =~ /^#!perl\b/) {
+ system $^X, $file
+ and die_255("$^X $file failed: \$!=$!, \$?=$?");
+ } elsif ($line =~ /^#!(\/\S+)/) {
+ system $file
+ and die_255("$file failed: \$!=$!, \$?=$?");
+ } else {
+ if (my ($target, $action, $pattern)
+ = $line =~ m#^(\S+) ([=!])~ /(.*)/#) {
+ if (length $pattern) {
+ next unless -f $target;
+ if ($action eq '=') {
+ next unless extract_from_file($target, $pattern);
+ } else {
+ next if extract_from_file($target, $pattern);
+ }
+ } else {
+ # Avoid the special case meaning of the empty pattern,
+ # and instead use this to simply test for the file being
+ # present or absent
+ if ($action eq '=') {
+ next unless -f $target;
+ } else {
+ next if -f $target;
+ }
+ }
+ }
+ system_or_die("patch -p1 <$file");
+ }
+ }
+}
+
# Local variables:
# cperl-indent-level: 4
# indent-tabs-mode: nil
diff --git a/Porting/bisect.pl b/Porting/bisect.pl
index 29e3ded..c52c740 100755
--- a/Porting/bisect.pl
+++ b/Porting/bisect.pl
@@ -11,8 +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);
+my ($start, $end, $validate, $usage, $bad, $jobs, $make);
$bad = !GetOptions('start=s' => \$start, 'end=s' => \$end,
+ 'jobs|j=i' => \$jobs, 'make=s' => \$make,
validate => \$validate, 'usage|help|?' => \$usage);
unshift @ARGV, '--help' if $bad || $usage;
unshift @ARGV, '--validate' if $validate;
@@ -36,6 +37,26 @@ exit 0 if $usage;
my $start_time = time;
+if (!defined $jobs &&
+ !($^O eq 'hpux' && system((defined $make ? $make : 'make')
+ . ' --version >/dev/null 2>&1'))) {
+ # Try to default to (ab)use all the CPUs:
+ my $cpus;
+ if (open my $fh, '<', '/proc/cpuinfo') {
+ while (<$fh>) {
+ ++$cpus if /^processor\s+:\s+\d+$/;
+ }
+ } elsif (-x '/sbin/sysctl') {
+ $cpus = $1 if `/sbin/sysctl hw.ncpu` =~ /^hw\.ncpu: (\d+)$/;
+ } elsif (-x '/usr/bin/getconf') {
+ $cpus = $1 if `/usr/bin/getconf _NPROCESSORS_ONLN` =~ /^(\d+)$/;
+ }
+ $jobs = defined $cpus ? $cpus + 1 : 2;
+}
+
+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);
@@ -114,6 +135,8 @@ if ($git_version ge v1.6.6) {
system "git checkout $end" and die;
my $ret = system $^X, $runner, @ARGV;
die "Runner returned $ret for end revision" unless $ret;
+die "Runner returned $ret for end revision, which is a skip"
+ if $ret == 125 * 256;
if (defined $start) {
system "git checkout $start" and die;
--
Perl5 Master Repository
