This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add Porting/bisect.pl, to automate bisecting a perl code test case.
authorNicholas Clark <nick@ccl4.org>
Thu, 29 Sep 2011 20:44:45 +0000 (22:44 +0200)
committerNicholas Clark <nick@ccl4.org>
Thu, 29 Sep 2011 20:44:45 +0000 (22:44 +0200)
MANIFEST
Porting/bisect-runner.pl [new file with mode: 0755]
Porting/bisect.pl [new file with mode: 0755]
Porting/exec-bit.txt

index aa7e9fd..b8c5d9c 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -4556,6 +4556,8 @@ pod/splitpod                      Splits perlfunc into multiple pod pages
 Policy_sh.SH                   Hold site-wide preferences between Configure runs.
 Porting/acknowledgements.pl    Generate perldelta acknowledgements text
 Porting/add-package.pl         Add/Update CPAN modules that are part of Core
+Porting/bisect.pl              A tool to make bisecting easy
+Porting/bisect-runner.pl       Tool to be called by git bisect run
 Porting/bump-perl-version      bump the perl version in relevant files
 Porting/check83.pl             Check whether we are 8.3-friendly
 Porting/checkansi.pl           Check source code for ANSI-C violations
diff --git a/Porting/bisect-runner.pl b/Porting/bisect-runner.pl
new file mode 100755 (executable)
index 0000000..8ee2af7
--- /dev/null
@@ -0,0 +1,168 @@
+#!/usr/bin/perl -w
+use strict;
+
+use Getopt::Long;
+
+my @targets = qw(miniperl perl test_prep);
+
+my $target = 'test_prep';
+my $j = '9';
+my $test_should_pass = 1;
+my $clean = 1;
+my $one_liner;
+
+sub usage {
+    die "$0: [--target=...] [-j=4] [--expect-pass=0|1] thing to test";
+}
+
+unless(GetOptions('target=s' => \$target,
+                 'jobs|j=i' => \$j,
+                 'expect-pass=i' => \$test_should_pass,
+                 'expect-fail' => sub { $test_should_pass = 0; },
+                 'clean!' => \$clean, # mostly for debugging this
+                 'one-liner|e=s' => \$one_liner,
+                )) {
+    usage();
+}
+
+my $expected = $target eq 'miniperl' ? 'miniperl' : 'perl';
+
+unshift @ARGV, "./$expected", '-e', $one_liner if defined $one_liner;
+
+usage() unless @ARGV;
+
+die "$0: Can't build $target" unless grep {@targets} $target;
+
+$j = "-j$j" if $j =~ /\A\d+\z/;
+
+sub extract_from_file {
+    my ($file, $rx, $default) = @_;
+    open my $fh, '<', $file or die "Can't open $file: $!";
+    while (<$fh>) {
+       my @got = $_ =~ $rx;
+       return wantarray ? @got : $got[0]
+           if @got;
+    }
+    return $default if defined $default;
+    return;
+}
+
+# Not going to assume that system perl is yet new enough to have autodie
+system 'git clean -dxf' and die;
+
+# 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 makedepend.SH
+system 'git show blead:makedepend.SH > makedepend.SH' and die;
+
+my @paths = qw(/usr/local/lib64 /lib64 /usr/lib64);
+
+# if Encode is not needed for the test, you can speed up the bisect by
+# excluding it from the runs with -Dnoextensions=Encode
+# ccache is an easy win. Remove it if it causes problems.
+my @ARGS = ('-des', '-Dusedevel', '-Doptimize=-g', '-Dcc=ccache gcc',
+           '-Dld=gcc', "-Dlibpth=@paths");
+
+# Commit 1cfa4ec74d4933da adds ignore_versioned_solibs to Configure, and sets it
+# to true in hints/linux.sh
+# On dromedary, from that point on, Configure (by default) fails to find any
+# libraries, because it scans /usr/local/lib /lib /usr/lib, which only contain
+# versioned libraries. Without -lm, the build fails.
+# Telling /usr/local/lib64 /lib64 /usr/lib64 works from that commit onwards,
+# until commit faae14e6e968e1c0 adds it to the hints.
+# However, prior to 1cfa4ec74d4933da telling Configure the truth doesn't work,
+# because it will spot versioned libraries, pass them to the compiler, and then
+# bail out pretty early on. Configure won't let us override libswanted, but it
+# will let us override the entire libs list.
+
+unless (extract_from_file('Configure', 'ignore_versioned_solibs')) {
+    # Before 1cfa4ec74d4933da, so force the libs list.
+
+    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
+                       ld sun m crypt sec util c cposix posix ucb BSD)) {
+       foreach my $dir (@paths) {
+           next unless -f "$dir/lib$lib.so";
+           push @libs, "-l$lib";
+           last;
+       }
+    }
+    push @ARGS, "-Dlibs=@libs";
+}
+
+# </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;
+if (!$pid) {
+    open STDIN, '<', '/dev/null';
+    exec './Configure', @ARGS;
+    die "Failed to start Configure: $!";
+}
+waitpid $pid, 0
+    or die "wait for Configure, pid $pid failed: $!";
+
+# Skip if something went wrong with Configure
+unless (-f 'config.sh') {
+    warn "skipping - no config.sh";
+    exit 125;
+}
+
+# Correct makefile for newer GNU gcc
+# Only really needed if you comment out the use of blead's makedepend.SH
+{
+    local $^I = "";
+    local @ARGV = qw(makefile x2p/makefile);
+    while (<>) {
+       print unless /<(?:built-in|command|stdin)/;
+    }
+}
+           
+# This changes to PERL_VERSION in 4d8076ea25903dcb in 1999
+my $major
+    = extract_from_file('patchlevel.h',
+                       qr/^#define\s+(?:PERL_VERSION|PATCHLEVEL)\s+(\d+)\s/,
+                       0);
+
+# Nearly all parallel build issues fixed by 5.10.0. Untrustworthy before that.
+$j = '' unless $major > 10;
+
+if ($target eq 'test_prep') {
+    if ($major < 8) {
+       # test-prep was added in 5.004_01, 3e3baf6d63945cb6.
+       # renamed to test_prep in 2001 in 5fe84fd29acaf55c.
+       # earlier than that, just make test. It will be fast enough.
+       $target = extract_from_file('Makefile.SH', qr/^(test[-_]prep):/, 'test');
+    }
+}
+
+system "make $j $target";
+
+if (!-x $expected) {
+    warn "skipping - could not build $target";
+    exit 125;
+}
+
+# This is what we came here to run:
+my $ret = system @ARGV;
+
+if ($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';
+    # 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';
+}
+
+my $got = ($test_should_pass ? !$ret : $ret) ? 'good' : 'bad';
+
+if ($ret) {
+    print "$got - non-zero exit from @ARGV\n";
+} else {
+    print "$got - zero exit from @ARGV\n";
+}
+
+exit($got eq 'bad');
diff --git a/Porting/bisect.pl b/Porting/bisect.pl
new file mode 100755 (executable)
index 0000000..bc462aa
--- /dev/null
@@ -0,0 +1,70 @@
+#!/usr/bin/perl -w
+use strict;
+
+my $start_time = time;
+
+use Getopt::Long;
+
+sub usage {
+    die "$0: [--start revlike] [--end revlike] [--target=...] [-j=4] [--expect-pass=0|1] thing to test";
+}
+
+my %options;
+unless(GetOptions(\%options,
+                 'start=s',
+                 'end=s',
+                 'target=s',
+                 'jobs|j=i',
+                 'expect-pass=i',
+                 'expect-fail',
+                 'one-liner|e=s',
+                )) {
+    usage();
+}
+
+my $start = delete $options{start};
+# Currently the earliest version that the runner can build
+$start = 'perl-5.005' unless defined $start;
+my $end = delete $options{end};
+$end = 'blead' unless defined $end;
+
+system "git rev-parse $start >/dev/null" and die;
+system "git rev-parse $end >/dev/null" and die;
+
+my $modified = () = `git ls-files --modified --deleted --others`;
+
+die "This checkout is not clean - $modified modified or untracked file(s)"
+    if $modified;
+
+system "git bisect reset" and die;
+
+my @ARGS;
+foreach (sort keys %options) {
+    push @ARGS, defined $options{$_} ? "--$_=$options{$_}" : "--$_";
+}
+push @ARGS, @ARGV;
+
+my $runner = $0;
+$runner =~ s/bisect\.pl/bisect-runner.pl/;
+
+die "Can't find bisect runner $runner" unless -f $runner;
+
+# Sanity check the first and last revisions:
+system "git checkout $start" and die;
+my $ret = system $^X, $runner, @ARGS;
+die "Runner returned $ret, not 0 for start revision" if $ret;
+
+system "git checkout $end" and die;
+$ret = system $^X, $runner, @ARGS;
+die "Runner returned $ret for end revision" unless $ret;
+
+system "git bisect start" and die;
+system "git bisect good $start" and die;
+system "git bisect bad $end" and die;
+
+# And now get git bisect to do the hard work:
+system 'git', 'bisect', 'run', $^X, $runner, @ARGS and die;
+
+my $end_time = time;
+
+printf "That took %d seconds\n", $end_time - $start_time;
index 73f6de8..07831be 100644 (file)
@@ -29,6 +29,8 @@ x2p/Makefile.SH
 x2p/cflags.SH
 Porting/Maintainers.pl
 Porting/add-package.pl
+Porting/bisect.pl
+Porting/bisect-runner.pl
 Porting/check83.pl
 Porting/checkAUTHORS.pl
 Porting/checkURL.pl