[perl5.git] / Porting / bisect-runner.pl

#!/usr/bin/perl -w
use strict;

use Getopt::Long;

my @targets = qw(miniperl lib/Config.pm perl test_prep);

my $target = 'test_prep';
my $j = '9';
my $test_should_pass = 1;
my $clean = 1;
my $one_liner;
my $match;
my $force_manifest;
my $test_build;

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,
                  'match=s' => \$match,
                  'force-manifest' => \$force_manifest,
                  'test-build' => \$test_build,
		 )) {
    usage();
}

my $exe = $target eq 'perl' || $target eq 'test_prep' ? 'perl' : 'miniperl';
my $expected = $target eq 'test_prep' ? 'perl' : $target;

unshift @ARGV, "./$exe", '-Ilib', '-e', $one_liner if defined $one_liner;

usage() unless @ARGV || $match || $test_build;

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;
}

sub clean {
    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';
    }
}

sub skip {
    my $reason = shift;
    clean();
    warn "skipping - $reason";
    exit 125;
}

sub report_and_exit {
    my ($ret, $pass, $fail, $desc) = @_;

    clean();

    my $got = ($test_should_pass ? !$ret : $ret) ? 'good' : 'bad';
    if ($ret) {
        print "$got - $fail $desc\n";
    } else {
        print "$got - $pass $desc\n";
    }

    exit($got eq 'bad');
}

# Not going to assume that system perl is yet new enough to have autodie
system 'git clean -dxf' and die;

if ($match) {
    my $matches;
    my $re = qr/$match/;
    foreach my $file (`git ls-files`) {
        chomp $file;
        open my $fh, '<', $file or die "Can't open $file: $!";
        while (<$fh>) {
            if ($_ =~ $re) {
                ++$matches;
                $_ .= "\n" unless /\n\z/;
                print "$file: $_";
            }
        }
        close $fh or die "Can't close $file: $!";
    }
    report_and_exit(!$matches, 'matches for', 'no matches for', $match);
}

skip('no Configure - is this the //depot/perlext/Compiler branch?')
    unless -f 'Configure';

# 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);

# 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";
}

# This seems to be necessary to avoid makedepend becoming confused, and hanging
# on stdin. Seems that the code after make shlist || ...here... is never run.
push @ARGS, q{-Dtrnl='\n'}
    if $major < 4;

my (@missing, @created_dirs);

if ($force_manifest) {
    open my $fh, '<', 'MANIFEST'
        or die "Could not open MANIFEST: $!";
    while (<$fh>) {
        next unless /^(\S+)/;
        push @missing, $1
            unless -f $1;
    }
    close $fh or die "Can't close MANIFEST: $!";

    foreach my $pathname (@missing) {
        my @parts = split '/', $pathname;
        my $leaf = pop @parts;
        my $path = '.';
        while (@parts) {
            $path .= '/' . shift @parts;
            next if -d $path;
            mkdir $path, 0700 or die "Can't create $path: $!";
            unshift @created_dirs, $path;
        }
        open $fh, '>', $pathname or die "Can't open $pathname: $!";
        close $fh or die "Can't close $pathname: $!";
        chmod 0, $pathname or die "Can't chmod 0 $pathname: $!";
    }
}

# </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) {
    # Before dfe9444ca7881e71, Configure would refuse to run if stdin was not a
    # tty. With that commit, the tty requirement was dropped for -de and -dE
    if($major > 4) {
        open STDIN, '<', '/dev/null';
    } elsif (!$force_manifest) {
        # 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 exit immediately and the check for config.sh below will skip.
        # To avoid a hang, we need to check MANIFEST for ourselves, and skip
        # if anything is missing.
        open my $fh, '<', 'MANIFEST';
        skip("Could not open MANIFEST: $!")
            unless $fh;
        while (<$fh>) {
            next unless /^(\S+)/;
            skip("$1 from MANIFEST doesn't exist")
                unless -f $1;
        }
        close $fh or die "Can't close MANIFEST: $!";
    }
    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
skip('no config.sh') unless -f 'config.sh';

# This is probably way too paranoid:
if (@missing) {
    my @errors;
    foreach my $file (@missing) {
        my (undef, undef, $mode, undef, undef, undef, undef, $size)
            = stat $file;
        if (!defined $mode) {
            push @errors, "Added file $file has been deleted by Configure";
            next;
        }
        if ($mode != 0) {
            push @errors,
                sprintf 'Added file %s had mode changed by Configure to %03o',
                    $file, $mode;
        }
        if ($size != 0) {
            push @errors,
                "Added file $file had sized changed by Configure to $size";
        }
        unlink $file or die "Can't unlink $file: $!";
    }
    foreach my $dir (@created_dirs) {
        rmdir $dir or die "Can't rmdir $dir: $!";
    }
}

# 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)/;
    }
}

# Parallel build for miniperl is safe
system "make $j miniperl";

if ($target ne 'miniperl') {
    # 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";
}

my $missing_target = $expected =~ /perl$/ ? !-x $expected : !-r $expected;

if ($test_build) {
    report_and_exit($missing_target, 'could build', 'could not build', $target);
} elsif ($missing_target) {
    skip("could not build $target");
}

# This is what we came here to run:
my $ret = system @ARGV;

report_and_exit($ret, 'zero exit from', 'non-zero exit from', "@ARGV");

# Local variables:
# cperl-indent-level: 4
# indent-tabs-mode: nil
# End:
#
# ex: set ts=8 sts=4 sw=4 et:
Commit	Line	Data
6a8dbfd7 NC	1	#!/usr/bin/perl -w
	2	use strict;
	3
	4	use Getopt::Long;
	5
4daf2803	6	my @targets = qw(miniperl lib/Config.pm perl test_prep);
6a8dbfd7 NC	7
	8	my $target = 'test_prep';
	9	my $j = '9';
	10	my $test_should_pass = 1;
	11	my $clean = 1;
	12	my $one_liner;
bc96a05a	13	my $match;
67382a3b NC	14	my $force_manifest;
67382a3b NC	15	my $test_build;
6a8dbfd7 NC	16
	17	sub usage {
	18	die "$0: [--target=...] [-j=4] [--expect-pass=0\|1] thing to test";
	19	}
	20
	21	unless(GetOptions('target=s' => \$target,
	22	'jobs\|j=i' => \$j,
	23	'expect-pass=i' => \$test_should_pass,
	24	'expect-fail' => sub { $test_should_pass = 0; },
	25	'clean!' => \$clean, # mostly for debugging this
	26	'one-liner\|e=s' => \$one_liner,
bc96a05a	27	'match=s' => \$match,
67382a3b NC	28	'force-manifest' => \$force_manifest,
67382a3b NC	29	'test-build' => \$test_build,
6a8dbfd7 NC	30	)) {
	31	usage();
	32	}
	33
4daf2803 NC	34	my $exe = $target eq 'perl' \|\| $target eq 'test_prep' ? 'perl' : 'miniperl';
4daf2803 NC	35	my $expected = $target eq 'test_prep' ? 'perl' : $target;
6a8dbfd7	36
4daf2803	37	unshift @ARGV, "./$exe", '-Ilib', '-e', $one_liner if defined $one_liner;
6a8dbfd7	38
67382a3b	39	usage() unless @ARGV \|\| $match \|\| $test_build;
6a8dbfd7 NC	40
	41	die "$0: Can't build $target" unless grep {@targets} $target;
	42
	43	$j = "-j$j" if $j =~ /\A\d+\z/;
	44
	45	sub extract_from_file {
	46	my ($file, $rx, $default) = @_;
	47	open my $fh, '<', $file or die "Can't open $file: $!";
	48	while (<$fh>) {
	49	my @got = $_ =~ $rx;
	50	return wantarray ? @got : $got[0]
	51	if @got;
	52	}
	53	return $default if defined $default;
	54	return;
	55	}
	56
ab4a15f9 NC	57	sub clean {
	58	if ($clean) {
	59	# Needed, because files that are build products in this checked out
	60	# version might be in git in the next desired version.
	61	system 'git clean -dxf';
	62	# Needed, because at some revisions the build alters checked out files.
	63	# (eg pod/perlapi.pod). Also undoes any changes to makedepend.SH
	64	system 'git reset --hard HEAD';
	65	}
	66	}
	67
	68	sub skip {
	69	my $reason = shift;
	70	clean();
	71	warn "skipping - $reason";
	72	exit 125;
	73	}
	74
f1050811 NC	75	sub report_and_exit {
	76	my ($ret, $pass, $fail, $desc) = @_;
	77
	78	clean();
	79
	80	my $got = ($test_should_pass ? !$ret : $ret) ? 'good' : 'bad';
	81	if ($ret) {
	82	print "$got - $fail $desc\n";
	83	} else {
	84	print "$got - $pass $desc\n";
	85	}
	86
	87	exit($got eq 'bad');
	88	}
	89
6a8dbfd7 NC	90	# Not going to assume that system perl is yet new enough to have autodie
	91	system 'git clean -dxf' and die;
	92
bc96a05a NC	93	if ($match) {
	94	my $matches;
	95	my $re = qr/$match/;
	96	foreach my $file (`git ls-files`) {
	97	chomp $file;
	98	open my $fh, '<', $file or die "Can't open $file: $!";
	99	while (<$fh>) {
	100	if ($_ =~ $re) {
	101	++$matches;
	102	$_ .= "\n" unless /\n\z/;
	103	print "$file: $_";
	104	}
	105	}
	106	close $fh or die "Can't close $file: $!";
	107	}
	108	report_and_exit(!$matches, 'matches for', 'no matches for', $match);
	109	}
	110
4b081584 NC	111	skip('no Configure - is this the //depot/perlext/Compiler branch?')
	112	unless -f 'Configure';
	113
dbcdc176 NC	114	# This changes to PERL_VERSION in 4d8076ea25903dcb in 1999
	115	my $major
	116	= extract_from_file('patchlevel.h',
	117	qr/^#define\s+(?:PERL_VERSION\|PATCHLEVEL)\s+(\d+)\s/,
	118	0);
	119
6a8dbfd7 NC	120	# There was a bug in makedepend.SH which was fixed in version 96a8704c.
	121	# Symptom was './makedepend: 1: Syntax error: Unterminated quoted string'
	122	# Remove this if you're actually bisecting a problem related to makedepend.SH
	123	system 'git show blead:makedepend.SH > makedepend.SH' and die;
	124
	125	my @paths = qw(/usr/local/lib64 /lib64 /usr/lib64);
	126
	127	# if Encode is not needed for the test, you can speed up the bisect by
	128	# excluding it from the runs with -Dnoextensions=Encode
	129	# ccache is an easy win. Remove it if it causes problems.
	130	my @ARGS = ('-des', '-Dusedevel', '-Doptimize=-g', '-Dcc=ccache gcc',
	131	'-Dld=gcc', "-Dlibpth=@paths");
	132
	133	# Commit 1cfa4ec74d4933da adds ignore_versioned_solibs to Configure, and sets it
	134	# to true in hints/linux.sh
	135	# On dromedary, from that point on, Configure (by default) fails to find any
	136	# libraries, because it scans /usr/local/lib /lib /usr/lib, which only contain
	137	# versioned libraries. Without -lm, the build fails.
	138	# Telling /usr/local/lib64 /lib64 /usr/lib64 works from that commit onwards,
	139	# until commit faae14e6e968e1c0 adds it to the hints.
	140	# However, prior to 1cfa4ec74d4933da telling Configure the truth doesn't work,
	141	# because it will spot versioned libraries, pass them to the compiler, and then
	142	# bail out pretty early on. Configure won't let us override libswanted, but it
	143	# will let us override the entire libs list.
	144
	145	unless (extract_from_file('Configure', 'ignore_versioned_solibs')) {
	146	# Before 1cfa4ec74d4933da, so force the libs list.
	147
	148	my @libs;
	149	# This is the current libswanted list from Configure, less the libs removed
	150	# by current hints/linux.sh
	151	foreach my $lib (qw(sfio socket inet nsl nm ndbm gdbm dbm db malloc dl dld
	152	ld sun m crypt sec util c cposix posix ucb BSD)) {
	153	foreach my $dir (@paths) {
	154	next unless -f "$dir/lib$lib.so";
	155	push @libs, "-l$lib";
	156	last;
	157	}
	158	}
	159	push @ARGS, "-Dlibs=@libs";
	160	}
	161
4b081584 NC	162	# This seems to be necessary to avoid makedepend becoming confused, and hanging
	163	# on stdin. Seems that the code after make shlist \|\| ...here... is never run.
	164	push @ARGS, q{-Dtrnl='\n'}
	165	if $major < 4;
	166
67382a3b NC	167	my (@missing, @created_dirs);
	168
	169	if ($force_manifest) {
	170	open my $fh, '<', 'MANIFEST'
	171	or die "Could not open MANIFEST: $!";
	172	while (<$fh>) {
	173	next unless /^(\S+)/;
	174	push @missing, $1
	175	unless -f $1;
	176	}
	177	close $fh or die "Can't close MANIFEST: $!";
	178
	179	foreach my $pathname (@missing) {
	180	my @parts = split '/', $pathname;
	181	my $leaf = pop @parts;
	182	my $path = '.';
	183	while (@parts) {
	184	$path .= '/' . shift @parts;
	185	next if -d $path;
	186	mkdir $path, 0700 or die "Can't create $path: $!";
	187	unshift @created_dirs, $path;
	188	}
	189	open $fh, '>', $pathname or die "Can't open $pathname: $!";
	190	close $fh or die "Can't close $pathname: $!";
	191	chmod 0, $pathname or die "Can't chmod 0 $pathname: $!";
	192	}
	193	}
	194
6a8dbfd7 NC	195	# </dev/null because it seems that some earlier versions of Configure can
	196	# call commands in a way that now has them reading from stdin (and hanging)
	197	my $pid = fork;
	198	die "Can't fork: $!" unless defined $pid;
	199	if (!$pid) {
dbcdc176 NC	200	# Before dfe9444ca7881e71, Configure would refuse to run if stdin was not a
dbcdc176 NC	201	# tty. With that commit, the tty requirement was dropped for -de and -dE
8754c3bb	202	if($major > 4) {
67382a3b NC	203	open STDIN, '<', '/dev/null';
67382a3b NC	204	} elsif (!$force_manifest) {
8754c3bb NC	205	# If a file in MANIFEST is missing, Configure asks if you want to
	206	# continue (the default being 'n'). With stdin closed or /dev/null,
	207	# it exit immediately and the check for config.sh below will skip.
	208	# To avoid a hang, we need to check MANIFEST for ourselves, and skip
	209	# if anything is missing.
	210	open my $fh, '<', 'MANIFEST';
	211	skip("Could not open MANIFEST: $!")
	212	unless $fh;
	213	while (<$fh>) {
	214	next unless /^(\S+)/;
	215	skip("$1 from MANIFEST doesn't exist")
	216	unless -f $1;
	217	}
	218	close $fh or die "Can't close MANIFEST: $!";
	219	}
6a8dbfd7 NC	220	exec './Configure', @ARGS;
	221	die "Failed to start Configure: $!";
	222	}
	223	waitpid $pid, 0
	224	or die "wait for Configure, pid $pid failed: $!";
	225
	226	# Skip if something went wrong with Configure
ab4a15f9	227	skip('no config.sh') unless -f 'config.sh';
6a8dbfd7	228
67382a3b NC	229	# This is probably way too paranoid:
	230	if (@missing) {
	231	my @errors;
	232	foreach my $file (@missing) {
	233	my (undef, undef, $mode, undef, undef, undef, undef, $size)
	234	= stat $file;
	235	if (!defined $mode) {
	236	push @errors, "Added file $file has been deleted by Configure";
	237	next;
	238	}
	239	if ($mode != 0) {
	240	push @errors,
	241	sprintf 'Added file %s had mode changed by Configure to %03o',
	242	$file, $mode;
	243	}
	244	if ($size != 0) {
	245	push @errors,
	246	"Added file $file had sized changed by Configure to $size";
	247	}
	248	unlink $file or die "Can't unlink $file: $!";
	249	}
	250	foreach my $dir (@created_dirs) {
	251	rmdir $dir or die "Can't rmdir $dir: $!";
	252	}
	253	}
	254
6a8dbfd7 NC	255	# Correct makefile for newer GNU gcc
	256	# Only really needed if you comment out the use of blead's makedepend.SH
	257	{
	258	local $^I = "";
	259	local @ARGV = qw(makefile x2p/makefile);
	260	while (<>) {
	261	print unless /<(?:built-in\|command\|stdin)/;
	262	}
	263	}
6a8dbfd7	264
9a999a97 NC	265	# Parallel build for miniperl is safe
	266	system "make $j miniperl";
	267
	268	if ($target ne 'miniperl') {
	269	# Nearly all parallel build issues fixed by 5.10.0. Untrustworthy before that.
	270	$j = '' unless $major > 10;
	271
	272	if ($target eq 'test_prep') {
	273	if ($major < 8) {
	274	# test-prep was added in 5.004_01, 3e3baf6d63945cb6.
	275	# renamed to test_prep in 2001 in 5fe84fd29acaf55c.
	276	# earlier than that, just make test. It will be fast enough.
	277	$target = extract_from_file('Makefile.SH', qr/^(test[-_]prep):/,
	278	'test');
	279	}
6a8dbfd7	280	}
6a8dbfd7	281
9a999a97 NC	282	system "make $j $target";
9a999a97 NC	283	}
6a8dbfd7	284
67382a3b NC	285	my $missing_target = $expected =~ /perl$/ ? !-x $expected : !-r $expected;
	286
	287	if ($test_build) {
	288	report_and_exit($missing_target, 'could build', 'could not build', $target);
	289	} elsif ($missing_target) {
	290	skip("could not build $target");
	291	}
6a8dbfd7 NC	292
	293	# This is what we came here to run:
	294	my $ret = system @ARGV;
	295
f1050811	296	report_and_exit($ret, 'zero exit from', 'non-zero exit from', "@ARGV");
9a999a97 NC	297
	298	# Local variables:
	299	# cperl-indent-level: 4
	300	# indent-tabs-mode: nil
	301	# End:
	302	#
	303	# ex: set ts=8 sts=4 sw=4 et: