1#!./miniperl -w
2use strict;
3use Config;
4use 5.012;
5die "Can't fork" unless $Config{d_fork};
6
7# Brute force testing for makedef.pl
8#
9# To use this...
10#
11# Before modifying makedef.pl, create your golden results:
12#
13# $ mkdir Gold
14# $ ./perl -Ilib Porting/exercise_makedef.pl Gold/
15# $ chmod -R -w Gold/
16# $ mkdr Test
17#
18# then modify makedef.pl
19#
20# then test
21#
22# $ ./perl -Ilib Porting/exercise_makedef.pl Test
23# $ diff -rpu Gold Test
24
25my $prefix = shift;
26die "$0 prefix" unless $prefix;
27die "No such directory $prefix" unless -d $prefix;
28
29my @unlink;
30sub END {
31    unlink @unlink;
32}
33
34$SIG{INT} = sub { die }; # Trigger END processing
35
36{
37    # needed for OS/2, so fake one up
38    my $mpm = 'miniperl.map';
39
40    die "$mpm exists" if -e $mpm;
41
42    open my $in, '<', 'av.c' or die "Can't open av.c: $!";
43    push @unlink, $mpm;
44    open my $out, '>', $mpm or die "Can't open $mpm: $!";
45    while (<$in>) {
46	print $out "f $1\n" if /^(Perl_[A-Za-z_0-9]+)\(pTHX/;
47    }
48    close $out or die "Can't close $mpm: $!";
49}
50
51my @args = (platform => [map {"PLATFORM=$_"} qw(aix win32 os2 vms test)],
52	    cflags => ['', 'CCFLAGS=-Dperl=rules -Dzzz'],
53	    Deq => ['', '-Dbeer=foamy'],
54	    D => ['', '-DPERL_IMPLICIT_SYS'],
55	    cctype => ['', 'CCTYPE=GCC'],
56	    filetype => ['', 'FILETYPE=def', 'FILETYPE=imp'],
57	    targ_dir => ['', 'TARG_DIR=t/../'],
58	   );
59
60sub expand {
61    my ($names, $args, $key, $vals, @rest) = @_;
62    if (defined $key) {
63	my $bad;
64	while (my ($i, $v) = each @$vals) {
65	    $bad += expand([@$names, "$key=$i"], [@$args, $v], @rest);
66	}
67	return $bad;
68    }
69    # time to process something:
70    my $name = join ',', @$names;
71    my @args = grep {length} @$args;
72
73    $ENV{PERL5LIB} = join $Config{path_sep}, @INC;
74    my $pid = fork;
75    unless ($pid) {
76	open STDOUT, '>', "$prefix/$name.out"
77	    or die "Can't open $prefix/$name.out: $!";
78	open STDERR, '>', "$prefix/$name.err"
79	    or die "Can't open $prefix/$name.err: $!";
80	exec $^X, 'makedef.pl', @args;
81	die "Something went horribly wrong: $!";
82    }
83    die "Bad waitpid: $!" unless waitpid $pid, 0 == $pid;
84    if ($?) {
85	print STDERR "`$^X makedef.pl @args` failed with $?\n";
86	print STDERR "See output in $prefix/$name.err\n";
87	return 1;
88    }
89    return 0;
90}
91
92my $bad = expand([], [], @args);
93exit($bad > 255 ? 255 : $bad);
94