use Getopt::Long qw(:config bundling no_auto_abbrev);
use Pod::Usage;
use Config;
+use File::Temp qw(tempdir);
+use File::Spec;
my @targets
- = qw(config.sh config.h miniperl lib/Config.pm Fcntl perl test_prep);
+ = qw(none config.sh config.h miniperl lib/Config.pm Fcntl perl test_prep);
my %options =
(
push @paths, $_;
}
}
+ push @paths, map {$_ . $linux64} qw(/usr/local/lib /lib /usr/lib)
+ if $linux64;
}
-push @paths, map {$_ . $linux64} qw(/usr/local/lib /lib /usr/lib);
-
my %defines =
(
usedevel => '',
optimize => '-g',
ld => 'cc',
- ($linux64 ? (libpth => \@paths) : ()),
+ (@paths ? (libpth => \@paths) : ()),
);
+# Needed for the 'ignore_versioned_solibs' emulation below.
+push @paths, qw(/usr/local/lib /lib /usr/lib)
+ unless $linux64;
+
unless(GetOptions(\%options,
- 'target=s', 'make=s', 'jobs|j=i', 'expect-pass=i',
+ 'target=s', 'make=s', 'jobs|j=i', 'crash', 'expect-pass=i',
'expect-fail' => sub { $options{'expect-pass'} = 0; },
- 'clean!', 'one-liner|e=s', 'c', 'l', 'w', 'match=s',
+ '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',
+ 'force-manifest', 'force-regen', 'setpgrp!', 'timeout=i',
+ 'test-build', 'validate',
'all-fixups', 'early-fixup=s@', 'late-fixup=s@', 'valgrind',
- 'check-args', 'check-shebang!', 'usage|help|?', 'A=s@',
+ 'check-args', 'check-shebang!', 'usage|help|?', 'gold=s',
+ 'module=s', 'with-module=s', 'cpan-config-dir=s',
+ 'A=s@',
'D=s@' => sub {
my (undef, $val) = @_;
if ($val =~ /\A([^=]+)=(.*)/s) {
if $options{validate} && !@ARGV;
pod2usage(exitval => 0, verbose => 2) if $options{usage};
+
+# This needs to be done before the next arguments check, as it's populating
+# @ARGV
+if (defined $target && $target =~ /\.t\z/) {
+ # t/TEST don't have a reliable way to run the test script under valgrind
+ # The $ENV{VALGRIND} code was only added after v5.8.0, and is more
+ # geared to logging than to exiting on failure if errors are found.
+ # I guess one could fudge things by replacing the symlink t/perl with a
+ # wrapper script which invokes valgrind, but leave doing that until
+ # someone needs it. (If that's you, then patches welcome.)
+ foreach (qw(valgrind match validate test-build one-liner)) {
+ die_255("$0: Test-case targets can't be run with --$_")
+ if $options{$_};
+ }
+ die_255("$0: Test-case targets can't be combined with an explicit test")
+ if @ARGV;
+
+ # Needing this unless is a smell suggesting that this implementation of
+ # test-case targets is not really in the right place.
+ unless ($options{'check-args'}) {
+ # The top level sanity tests refuse to start or end a test run at a
+ # revision which skips, hence this test ensures reasonable sanity at
+ # automatically picking a suitable start point for both normal operation
+ # and --expect-fail
+ skip("Test case $target is not a readable file")
+ unless -f $target && -r _;
+ }
+
+ # t/TEST runs from and takes pathnames relative to t/, so need to strip
+ # out a leading t, or add ../ otherwise
+ unless ($target =~ s!\At/!!) {
+ $target = "../$target";
+ }
+ @ARGV = ('sh', '-c', "cd t && ./perl TEST " . quotemeta $target);
+ $target = 'test_prep';
+}
+
pod2usage(exitval => 255, verbose => 1)
- unless @ARGV || $match || $options{'test-build'} || defined $options{'one-liner'};
+ unless @ARGV || $match || $options{'test-build'} || defined $options{'one-liner'} || defined $options{module};
pod2usage(exitval => 255, verbose => 1)
if !$options{'one-liner'} && ($options{l} || $options{w});
=head1 SYNOPSIS
- # When did this become an error?
- .../Porting/bisect.pl -e 'my $a := 2;'
- # When did this stop being an error?
- .../Porting/bisect.pl --expect-fail -e '1 // 2'
- # When were all lines matching this pattern removed from all files?
- .../Porting/bisect.pl --match '\b(?:PL_)hash_seed_set\b'
- # 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 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;'
- # What was the last revision to build with these options?
- .../Porting/bisect.pl --test-build -Dd_dosuid
- # When did this test program start generating errors from valgrind?
- .../Porting/bisect.pl --valgrind ../test_prog.pl
+ # When did this become an error?
+ .../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 test start failing?
+ .../Porting/bisect.pl --target t/op/sort.t
+ # When were all lines matching this pattern removed from all files?
+ .../Porting/bisect.pl --match '\b(?:PL_)hash_seed_set\b'
+ # 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 exiting 0?
+ .../Porting/bisect.pl -- ./perl -Ilib ../test_prog.pl
+ # When did this test program start crashing (any signal or coredump)?
+ .../Porting/bisect.pl --crash -- ./perl -Ilib ../test_prog.pl
+ # When did this first become valid syntax?
+ .../Porting/bisect.pl --target=miniperl --end=v5.10.0 \
+ --expect-fail -e 'my $a := 2;'
+ # What was the last revision to build with these options?
+ .../Porting/bisect.pl --test-build -Dd_dosuid
+ # When did this test program start generating errors from valgrind?
+ .../Porting/bisect.pl --valgrind ../test_prog.pl
+ # When did these cpan modules start failing to compile/pass tests?
+ .../Porting/bisect.pl --module=autobox,Moose
+ # When did this code stop working in blead with these modules?
+ .../Porting/bisect.pl --with-module=Moose,Moo -e 'use Moose; 1;'
+ # Like the above 2 but with custom CPAN::MyConfig
+ .../Porting/bisect.pl --module=Moo --cpan-config-dir=/home/blah/custom/
=head1 DESCRIPTION
By default F<bisect.pl> will process all options, then use the rest of the
command line as arguments to list C<system> 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<blead> (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<bisect.pl> will use F<bisect-runner.pl> to find the earliest
-stable perl version on which the test case passes, check that it fails on
-blead, and then use F<bisect-runner.pl> with C<git bisect run> to find the
-commit which caused the failure.
+non-zero) on I<blead>. F<bisect.pl> will use F<bisect-runner.pl> to find the
+earliest stable perl version on which the test case passes, check that it
+fails on blead, and then use F<bisect-runner.pl> with C<git bisect run> to
+find the commit which caused the failure.
+
+Many of perl's own test scripts exit 0 even if their TAP reports test
+failures, and some need particular setup (such as running from the right
+directory, or adding C<-T> to the command line). Hence if you want to bisect
+a test script, you can specify it with the I<--target> option, and it will
+be invoked using F<t/TEST> which performs all the setup, and exits non-zero
+if the TAP reports failures. This works for any file ending C<.t>, so you can
+use it with a file outside of the working checkout, for example to test a
+particular version of a test script, as a path inside the repository will
+(of course) be testing the version of the script checked out for the current
+revision, which may be too early to have the test you are interested in.
Because the test case is the complete argument to C<system>, it is easy to
run something other than the F<perl> built, if necessary. If you need to run
(whether executable or not), matching C<qr{\A#!./(?:mini)?perl\b}> then it
will have C<./perl> <-Ilib> (or C<./miniperl>) prepended to it.
-You need a clean checkout to run a bisect, and you can't use the checkout
-which contains F<Porting/bisect.pl> (because C<git bisect>) will check out
-a revision before F<Porting/bisect-runner.pl> was added, which
-C<git bisect run> needs). If your working checkout is called F<perl>, the
-simplest solution is to make a local clone, and run from that. I<i.e.>:
+You need a clean checkout to run a bisect. You can use the checkout
+containing F<Porting/bisect.pl> if you wish - in this case
+F<Porting/bisect.pl> will copy F<Porting/bisect-runner.pl> to a temporary
+file generated by C<File::Temp::tempfile()>. If doing this, beware that when
+the bisect ends (or you abort it) then your checkout is no longer at
+C<blead>, so you will need to C<git checkout blead> before restarting, to
+get the current version of F<Porting/bisect.pl> again. It's often easier
+either to copy F<Porting/bisect.pl> and F<Porting/bisect-runner.pl> to
+another directory (I<e.g.> F<~/bin>, if you have one), or to create a second
+git repository for running bisect. To create a second local repository, if
+your working checkout is called F<perl>, a simple solution is to make a
+local clone, and run from that. I<i.e.>:
cd ..
git clone perl perl2
Earliest revision to test, as a I<commit-ish> (a tag, commit or anything
else C<git> understands as a revision). If not specified, F<bisect.pl> will
-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<bisect.pl> detects that
-the checkout is on a case insensitive file system, it will search from
-5.005 to 5.14.0
+search stable .0 perl releases until it finds one where the test case
+passes. The default is to search from 5.002 to the most recent tagged stable
+release (v5.18.0 at the time of writing). If F<bisect.pl> detects that the
+checkout is on a case insensitive file system, it will search from 5.005 to
+the most recent tagged stable release. Only .0 stable releases are used
+because these are the only stable releases that are parents of blead, and
+hence suitable for a bisect run.
=item *
=item *
+I<none>
+
+Don't build anything - just run the user test case against a clean checkout.
+Using this gives a couple of features that a plain C<git bisect run> can't
+offer - automatic start revision detection, and test case C<--timeout>.
+
+=item *
+
I<config.sh>
Just run F<./Configure>
run, as there is no target provided to just get things ready, and for 5.004
and earlier the tests run very quickly.
+=item *
+
+A file ending C<.t>
+
+Build everything needed to run the tests, and then run this test script using
+F<t/TEST>. This is actually implemented internally by using the target
+I<test_prep>, and setting the test case to "sh", "-c", "cd t && ./TEST ..."
+
=back
=item *
or F<./miniperl> if I<target> is C<miniperl>.
(Usually you'll use C<-e> instead of providing a test case in the
-non-option arguments to F<bisect.pl>)
+non-option arguments to F<bisect.pl>. You can repeat C<-e> on the command
+line, just like you can with C<perl>)
C<-E> intentionally isn't supported, as it's an error in 5.8.0 and earlier,
which interferes with detecting errors in the example code itself.
=item *
+--crash
+
+Treat any non-crash as success, any crash as failure. (Crashing defined
+as exiting with a signal or a core dump.)
+
+=item *
+
-D I<config_arg=value>
=item *
=item *
+--module module1,module2,...
+
+Install this (or these) module(s), die when it (the last of those)
+cannot be updated to the current version.
+
+Misnomer. the argument can be any argument that can be passed to CPAN
+shell's install command. B<But>: since we only have the uptodate
+command to verify that an install has taken place, we are unable to
+determine success for arguments like
+MSCHWERN/Test-Simple-1.005000_005.tar.gz.
+
+In so far, it is not such a misnomer.
+
+Note that this and I<--with-module> will both require a C<CPAN::MyConfig>.
+If F<$ENV{HOME}/.cpan/CPAN/MyConfig.pm> does not exist, a CPAN shell will
+be started up for you so you can configure one. Feel free to let
+CPAN pick defaults for you. Enter 'quit' when you are done, and
+then everything should be all set. Alternatively, you may
+specify a custom C<CPAN::MyConfig> by using I<--cpan-config-dir>.
+
+Also, if you want to bisect a module that needs a display (like
+TK) and you don't want random screens appearing and disappearing
+on your computer while you're working, you can do something like
+this:
+
+In a terminal:
+
+ $ while true; do date ; if ! ps auxww | grep -v grep \
+ | grep -q Xvfb; then Xvfb :121 & fi; echo -n 'sleeping 60 '; \
+ sleep 60; done
+
+And then:
+
+ DISPLAY=":121" .../Porting/bisect.pl --module=TK
+
+(Some display alternatives are vncserver and Xnest.)
+
+=item *
+
+--with-module module1,module2,...
+
+Like I<--module> above, except this simply installs the requested
+modules and they can then be used in other tests.
+
+For example:
+
+ .../Porting/bisect.pl --with-module=Moose -e 'use Moose; ...'
+
+=item *
+
+--cpan-config-dir /home/blah/custom
+
+If defined, this will cause L<CPAN> to look for F<CPAN/MyConfig.pm> inside of
+the specified directory, instead of using the default config of
+F<$ENV{HOME}/.cpan/>.
+
+If no default config exists, a L<CPAN> shell will be fired up for you to
+configure things. Letting L<CPAN> automatically configure things for you
+should work well enough. You probably want to choose I<manual> instead of
+I<local::lib> if it asks. When you're finished with configuration, just
+type I<q> and hit I<ENTER> and the bisect should continue.
+
+=item *
+
--force-manifest
By default, a build will "skip" if any files listed in F<MANIFEST> are not
=item *
+--timeout I<seconds>
+
+Run the testcase with the given timeout. If this is exceeded, kill it (and
+by default all its children), and treat it as a failure.
+
+=item *
+
+--setpgrp
+
+Run the testcase in its own process group. Specifically, call C<setpgrp 0, 0>
+just before C<exec>-ing the user testcase. The default is not to set the
+process group, unless a timeout is used.
+
+=item *
+
--all-fixups
F<bisect-runner.pl> will minimally patch various files on a platform and
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,
+for a revision which would usually have already I<skip>ped. If this happens,
please report it as a bug, giving the OS and problem revision.
=item *
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
+successful match) which is not useful here, the treatment of an 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
--validate
-Test that all stable revisions can be built. By default, attempts to build
-I<blead>, I<v5.14.0> .. I<perl-5.002> (or I<perl5.005> 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
+Test that all stable (.0) revisions can be built. By default, attempts to
+build I<blead>, then tagged stable releases in reverse order down to
+I<perl-5.002> (or I<perl5.005> 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 -le 'print "Hello from $]"'
=item *
+--gold
+
+Revision to use when checking out known-good recent versions of files,
+such as F<makedepend.SH>. F<bisect-runner.pl> defaults this to I<blead>,
+but F<bisect.pl> will default it to the most recent stable release.
+
+=item *
+
--usage
=item *
system($command) and croak_255("'$command' failed, \$!=$!, \$?=$?");
}
+sub run_with_options {
+ my $options = shift;
+ my $name = $options->{name};
+ $name = "@_" unless defined $name;
+
+ my $setgrp = $options->{setpgrp};
+ if ($options->{timeout}) {
+ # Unless you explicitly disabled it on the commandline, set it:
+ $setgrp = 1 unless defined $setgrp;
+ }
+ my $pid = fork;
+ die_255("Can't fork: $!") unless defined $pid;
+ if (!$pid) {
+ if (exists $options->{stdin}) {
+ open STDIN, '<', $options->{stdin}
+ or die "Can't open STDIN from $options->{stdin}: $!";
+ }
+ if ($setgrp) {
+ setpgrp 0, 0
+ or die "Can't setpgrp 0, 0: $!";
+ }
+ { exec @_ };
+ die_255("Failed to start $name: $!");
+ }
+ my $start;
+ if ($options->{timeout}) {
+ require Errno;
+ require POSIX;
+ die_255("No POSIX::WNOHANG")
+ unless &POSIX::WNOHANG;
+ $start = time;
+ $SIG{ALRM} = sub {
+ my $victim = $setgrp ? -$pid : $pid;
+ my $delay = 1;
+ kill 'TERM', $victim;
+ waitpid(-1, &POSIX::WNOHANG);
+ while (kill 0, $victim) {
+ sleep $delay;
+ waitpid(-1, &POSIX::WNOHANG);
+ $delay *= 2;
+ if ($delay > 8) {
+ if (kill 'KILL', $victim) {
+ print STDERR "$0: Had to kill 'KILL', $victim\n"
+ } elsif (! $!{ESRCH}) {
+ print STDERR "$0: kill 'KILL', $victim failed: $!\n";
+ }
+ last;
+ }
+ }
+ report_and_exit(0, 'No timeout', 'Timeout', "when running $name");
+ };
+ alarm $options->{timeout};
+ }
+ waitpid $pid, 0
+ or die_255("wait for $name, pid $pid failed: $!");
+ alarm 0;
+ if ($options->{timeout}) {
+ my $elapsed = time - $start;
+ if ($elapsed / $options->{timeout} > 0.8) {
+ print STDERR "$0: Beware, took $elapsed seconds of $options->{timeout} permitted to run $name\n";
+ }
+ }
+ return $?;
+}
+
sub extract_from_file {
my ($file, $rx, $default) = @_;
my $fh = open_or_die($file);
my ($patch, $what, $files) = @_;
$what = 'patch' unless defined $what;
unless (defined $files) {
- $patch =~ m!^--- a/(\S+)\n\+\+\+ b/\1!sm;
+ $patch =~ m!^--- [ab]/(\S+)\n\+\+\+ [ba]/\1!sm;
$files = " $1";
}
my $patch_to_use = placate_patch_prog($patch);
sub checkout_file {
my ($file, $commit) = @_;
- $commit ||= 'blead';
+ $commit ||= $options{gold} || 'blead';
system "git show $commit:$file > $file </dev/null"
and die_255("Could not extract $file at revision $commit");
}
if ($options{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 </dev/null';
+ system 'git clean -qdxf </dev/null';
# 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 </dev/null';
}
sub report_and_exit {
- my ($ret, $pass, $fail, $desc) = @_;
+ my ($good, $pass, $fail, $desc) = @_;
clean();
- my $got = ($options{'expect-pass'} ? !$ret : $ret) ? 'good' : 'bad';
- if ($ret) {
- print "$got - $fail $desc\n";
- } else {
+ my $got = ($options{'expect-pass'} ? $good : !$good) ? 'good' : 'bad';
+ if ($good) {
print "$got - $pass $desc\n";
+ } else {
+ print "$got - $fail $desc\n";
}
exit($got eq 'bad');
}
+sub run_report_and_exit {
+ my $ret = run_with_options({setprgp => $options{setpgrp},
+ timeout => $options{timeout},
+ }, @_);
+ $ret &= 0xff if $options{crash};
+ report_and_exit(!$ret, 'zero exit from', 'non-zero exit from', "@_");
+}
+
sub match_and_exit {
my ($target, @globs) = @_;
my $matches = 0;
while (<$fh>) {
if ($_ =~ $re) {
++$matches;
- if (tr/\t\r\n -~\200-\377//c) {
+ if (/[^[:^cntrl:]\h\v]/a) { # Matches non-spacing non-C1 controls
print "Binary file $file matches\n";
} else {
$_ .= "\n" unless /\n\z/;
}
close_or_die($fh);
}
- report_and_exit(!$matches,
+ report_and_exit($matches,
$matches == 1 ? '1 match for' : "$matches matches for",
'no matches for', $match);
}
if (!defined $target) {
match_and_exit(undef, @ARGV) if $match;
$target = 'test_prep';
+} elsif ($target eq 'none') {
+ match_and_exit(undef, @ARGV) if $match;
+ run_report_and_exit(@ARGV);
}
skip('no Configure - is this the //depot/perlext/Compiler branch?')
qr/^#define\s+(?:PERL_VERSION|PATCHLEVEL)\s+(\d+)\s/,
0);
+my $unfixable_db_file;
+
+if ($major < 10
+ && !extract_from_file('ext/DB_File/DB_File.xs',
+ qr!^#else /\* Berkeley DB Version > 2 \*/$!)) {
+ # This DB_File.xs is really too old to patch up.
+ # Skip DB_File, unless we're invoked with an explicit -Unoextensions
+ if (!exists $defines{noextensions}) {
+ $defines{noextensions} = 'DB_File';
+ } elsif (defined $defines{noextensions}) {
+ $defines{noextensions} .= ' DB_File';
+ }
+ ++$unfixable_db_file;
+}
+
patch_Configure();
patch_hints();
if ($options{'all-fixups'}) {
my @libs;
# This is the current libswanted list from Configure, less the libs removed
# by current hints/linux.sh
- foreach my $lib (qw(sfio socket inet nsl nm ndbm gdbm dbm db malloc dl dld
+ foreach my $lib (qw(sfio socket inet nsl nm ndbm gdbm dbm db malloc dl
ld sun m crypt sec util c cposix posix ucb BSD)) {
foreach my $dir (@paths) {
# Note the wonderful consistency of dot-or-not in the config vars:
}
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_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_255("Failed to start Configure: $!");
+my $prefix;
+
+# Testing a module? We need to install perl/cpan modules to a temp dir
+if ($options{module} || $options{'with-module'}) {
+ $prefix = tempdir(CLEANUP => 1);
+
+ push @ARGS, "-Dprefix=$prefix";
+ push @ARGS, "-Uversiononly", "-Dinstallusrbinperl=n";
}
-waitpid $pid, 0
- or die_255("wait for Configure, pid $pid failed: $!");
+
+# 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.
+# Without redirecting stdin, the commands called will attempt to read from
+# stdin (and thus effectively hang)
+run_with_options({stdin => '/dev/null', name => 'Configure'},
+ './Configure', @ARGS);
patch_SH() unless $options{'all-fixups'};
apply_fixups($options{'late-fixup'});
if ($target =~ /config\.s?h/) {
match_and_exit($target, @ARGV) if $match && -f $target;
- report_and_exit(!-f $target, 'could build', 'could not build', $target)
+ report_and_exit(-f $target, 'could build', 'could not build', $target)
if $options{'test-build'};
skip("could not build $target") unless -f $target;
- my $ret = system @ARGV;
- report_and_exit($ret, 'zero exit from', 'non-zero exit from', "@ARGV");
+ run_report_and_exit(@ARGV);
} elsif (!-f 'config.sh') {
# Skip if something went wrong with Configure
system "$options{make} $j $real_target </dev/null";
}
+# Testing a cpan module? See if it will install
+if ($options{module} || $options{'with-module'}) {
+ # First we need to install this perl somewhere
+ system_or_die('./installperl');
+
+ my @m = split(',', $options{module} || $options{'with-module'});
+
+ my $bdir = File::Temp::tempdir(
+ CLEANUP => 1,
+ ) or die $!;
+
+ # Don't ever stop to ask the user for input
+ $ENV{AUTOMATED_TESTING} = 1;
+ $ENV{PERL_MM_USE_DEFAULT} = 1;
+
+ # Don't let these interfere with our cpan installs
+ delete $ENV{PERL_MB_OPT};
+ delete $ENV{PERL_MM_OPT};
+
+ # Make sure we load up our CPAN::MyConfig and then
+ # override the build_dir so we have a fresh one
+ # every build
+ my $cdir = $options{'cpan-config-dir'}
+ || File::Spec->catfile($ENV{HOME},".cpan");
+
+ my @cpanshell = (
+ "$prefix/bin/perl",
+ "-I", "$cdir",
+ "-MCPAN::MyConfig",
+ "-MCPAN",
+ "-e","\$CPAN::Config->{build_dir}=q{$bdir};",
+ "-e",
+ );
+
+ for (@m) {
+ s/-/::/g if /-/ and !m|/|;
+ }
+ my $install = join ",", map { "'$_'" } @m;
+ my $last = $m[-1];
+ my $shellcmd = "install($install); die unless CPAN::Shell->expand(Module => '$last')->uptodate;";
+
+ if ($options{module}) {
+ run_report_and_exit(@cpanshell, $shellcmd);
+ } else {
+ my $ret = run_with_options({setprgp => $options{setpgrp},
+ timeout => $options{timeout},
+ }, @cpanshell, $shellcmd);
+ $ret &= 0xff if $options{crash};
+
+ # Failed? Give up
+ if ($ret) {
+ report_and_exit(!$ret, 'zero exit from', 'non-zero exit from', "@_");
+ }
+ }
+}
+
my $expected_file_found = $expected_file =~ /perl$/
? -x $expected_file : -r $expected_file;
}
if ($options{'test-build'}) {
- report_and_exit(!$expected_file_found, 'could build', 'could not build',
+ report_and_exit($expected_file_found, 'could build', 'could not build',
$real_target);
} elsif (!$expected_file_found) {
skip("could not build $real_target");
if (defined $options{'one-liner'}) {
my $exe = $target =~ /^(?:perl$|test)/ ? 'perl' : 'miniperl';
- unshift @ARGV, '-e', $options{'one-liner'};
+ unshift @ARGV, map {('-e', $_)} @{$options{'one-liner'}};
foreach (qw(c l w)) {
unshift @ARGV, "-$_" if $options{$_};
}
}
}
-my $ret = system @ARGV;
-
-report_and_exit($ret, 'zero exit from', 'non-zero exit from', "@ARGV");
+run_report_and_exit(@ARGV);
############################################################################
#
EOPATCH
}
+ if ($major == 4 && extract_from_file('Configure', qr/^d_gethbynam=/)) {
+ # Fixes a bug introduced in 4599a1dedd47b916
+ apply_commit('3cbc818d1d0ac470');
+ }
+
+ if ($major == 4 && extract_from_file('Configure',
+ qr/gethbadd_addr_type=`echo \$gethbadd_addr_type/)) {
+ # Fixes a bug introduced in 3fd537d4b944bc7a
+ apply_commit('6ff9219da6cf8cfd');
+ }
+
+ if ($major == 4 && extract_from_file('Configure',
+ qr/^pthreads_created_joinable=/)) {
+ # Fix for bug introduced in 52e1cb5ebf5e5a8c
+ # Part of commit ce637636a41b2fef
+ edit_file('Configure', sub {
+ my $code = shift;
+ $code =~ s{^pthreads_created_joinable=''}
+ {d_pthreads_created_joinable=''}ms
+ or die_255("Substitution failed");
+ $code =~ s{^pthreads_created_joinable='\$pthreads_created_joinable'}
+ {d_pthreads_created_joinable='\$d_pthreads_created_joinable'}ms
+ or die_255("Substitution failed");
+ return $code;
+ });
+ }
+
if ($major < 5 && extract_from_file('Configure',
qr!if \$cc \$ccflags try\.c -o try >/dev/null 2>&1; then!)) {
# Analogous to the more general fix of dfe9444ca7881e71
if ($major == 4 && $^O eq 'linux') {
# Whilst this is fixed properly in f0784f6a4c3e45e1 which provides the
# Configure probe, it's easier to back out the problematic changes made
- # in these previous commits:
+ # in these previous commits.
+
+ # In maint-5.004, the simplest addition is to "correct" the file to
+ # use the same pre-processor macros as blead had used. Whilst commit
+ # 9b599b2a63d2324d (reverted below) is described as
+ # [win32] merge change#887 from maintbranch
+ # it uses __sun__ and __svr4__ instead of the __sun and __SVR4 of the
+ # maint branch commit 6cdf74fe31f049dc
+
+ edit_file('doio.c', sub {
+ my $code = shift;
+ $code =~ s{defined\(__sun\) && defined\(__SVR4\)}
+ {defined(__sun__) && defined(__svr4__)}g;
+ return $code;
+ });
+
if (extract_from_file('doio.c',
qr!^/\* XXX REALLY need metaconfig test \*/$!)) {
revert_commit('4682965a1447ea44', 'doio.c');
}
if ($major < 10) {
- if (!extract_from_file('ext/DB_File/DB_File.xs',
- qr!^#else /\* Berkeley DB Version > 2 \*/$!)) {
- # This DB_File.xs is really too old to patch up.
- # Skip DB_File, unless we're invoked with an explicit -Unoextensions
- if (!exists $defines{noextensions}) {
- $defines{noextensions} = 'DB_File';
- } elsif (defined $defines{noextensions}) {
- $defines{noextensions} .= ' DB_File';
- }
+ if ($unfixable_db_file) {
+ # Nothing we can do.
} elsif (!extract_from_file('ext/DB_File/DB_File.xs',
qr/^#ifdef AT_LEAST_DB_4_1$/)) {
# This line is changed by commit 3245f0580c13b3ab
}
}
-# Local variables:
-# cperl-indent-level: 4
-# indent-tabs-mode: nil
-# End:
-#
# ex: set ts=8 sts=4 sw=4 et: