use Config;
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 =
(
$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|?', 'gold=s',
'A=s@',
=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>
=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
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}: $!";
+ 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: $!");
+ 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 $?;
}
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);
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 run_report_and_exit {
- my $ret = system @_;
+ my $ret = run_with_options({setprgp => $options{setpgrp},
+ timeout => $options{timeout},
+ }, @_);
report_and_exit(!$ret, 'zero exit from', 'non-zero exit from', "@_");
}
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?')
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
https://perl5.git.perl.org / perl5.git / blobdiff