From 6a8dbfd7fdd5687ed748747ea8902c967c879870 Mon Sep 17 00:00:00 2001 From: Nicholas Clark Date: Thu, 29 Sep 2011 22:44:45 +0200 Subject: [PATCH] Add Porting/bisect.pl, to automate bisecting a perl code test case. --- MANIFEST | 2 + Porting/bisect-runner.pl | 168 +++++++++++++++++++++++++++++++++++++++++++++++ Porting/bisect.pl | 70 ++++++++++++++++++++ Porting/exec-bit.txt | 2 + 4 files changed, 242 insertions(+) create mode 100755 Porting/bisect-runner.pl create mode 100755 Porting/bisect.pl diff --git a/MANIFEST b/MANIFEST index aa7e9fd..b8c5d9c 100644 --- 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 index 0000000..8ee2af7 --- /dev/null +++ b/Porting/bisect-runner.pl @@ -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"; +} + +# ) { + 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 index 0000000..bc462aa --- /dev/null +++ b/Porting/bisect.pl @@ -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; diff --git a/Porting/exec-bit.txt b/Porting/exec-bit.txt index 73f6de8..07831be 100644 --- a/Porting/exec-bit.txt +++ b/Porting/exec-bit.txt @@ -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 -- 2.7.4