Add a utility to help test makedef.pl

The output of makedef.pl varies too much based on local configuration to allow
us to generate any useful pre-canned expectations of correctness. Hence the only
real option left is to generate "Golden" results for the local platform prior to
any modification, and then compare post modification output with them, to see
that nothing (unexpected) changed. exercise_makedef.pl captures all output for
(currently) 576 permutations of command line parameters, to enable this testing.

diff --git a/MANIFEST b/MANIFEST
index d3e5632e0aa34683d667688b02cd277781f56c10..e304e9eb263a2d8f34df920980f7b6b244155402 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -4524,6 +4524,7 @@ Porting/corelist.pl               Generates data for Module::CoreList
 Porting/curliff.pl             Curliff or liff your curliffable files.
 Porting/epigraphs.pod          the release epigraphs used over the years
 Porting/exec-bit.txt           List of files that get +x in release tarball
+Porting/exercise_makedef.pl    Brute force testing for makedef.pl
 Porting/expand-macro.pl                A tool to expand C macro definitions in the Perl source
 Porting/findrfuncs             Find reentrant variants of functions used in an executable
 Porting/findvars               Find occurrences of words

diff --git a/Porting/exercise_makedef.pl b/Porting/exercise_makedef.pl
new file mode 100644 (file)
index 0000000..3588192
--- /dev/null
+++ b/Porting/exercise_makedef.pl
@@ -0,0 +1,92 @@
+#!./miniperl -w
+use strict;
+use Config;
+use 5.012;
+die "Can't fork" unless $Config{d_fork};
+
+# Brute force testing for makedef.pl
+#
+# To use this...
+#
+# Before modifying makedef.pl, create your golden results:
+#
+# $ mkdir Gold
+# $ ./perl -Ilib Porting/exercise_makedef.pl Gold/
+# $ chmod -R -w Gold/
+# $ mkdr Test
+#
+# then modify makedef.pl
+#
+# then test
+#
+# $ ./perl -Ilib Porting/exercise_makedef.pl Test
+# $ diff -rpu Gold Test
+
+my $prefix = shift;
+die "$0 prefix" unless $prefix;
+die "No such directory $prefix" unless -d $prefix;
+
+my @unlink;
+sub END {
+    unlink @unlink;
+}
+
+$SIG{INT} = sub { die }; # Trigger END processing
+
+{
+    # needed for OS/2, so fake one up
+    my $mpm = 'miniperl.map';
+
+    die "$mpm exists" if -e $mpm;
+
+    open my $in, '<', 'av.c' or die "Can't open av.c: $!";
+    push @unlink, $mpm;
+    open my $out, '>', $mpm or die "Can't open $mpm: $!";
+    while (<$in>) {
+       print $out "f $1\n" if /^(Perl_[A-Za-z_0-9]+)\(pTHX/;
+    }
+    close $out or die "Can't close $mpm: $!";
+}
+
+my @args = (platform => [map {"PLATFORM=$_"} qw(aix win32 wince os2 netware vms)],
+           cflags => ['', 'CCFLAGS=-Dperl=rules -Dzzz'],
+           Deq => ['', '-Dbeer=foamy'],
+           D => ['', '-DPERL_IMPLICIT_SYS'],
+           cctype => ['', map {"CCTYPE=$_"} qw (MSVC60 GCC BORLAND)],
+           filetype => ['', 'FILETYPE=def', 'FILETYPE=imp'],
+          );
+
+sub expand {
+    my ($names, $args, $key, $vals, @rest) = @_;
+    if (defined $key) {
+       my $bad;
+       while (my ($i, $v) = each @$vals) {
+           $bad += expand([@$names, "$key=$i"], [@$args, $v], @rest);
+       }
+       return $bad;
+    }
+    # time to process something:
+    my $name = join ',', @$names;
+    my @args = grep {length} @$args;
+
+    $ENV{PERL5LIB} = join $Config{path_sep}, @INC;
+    my $pid = fork;
+    unless ($pid) {
+       open STDOUT, '>', "$prefix/$name.out"
+           or die "Can't open $prefix/$name.out: $!";
+       open STDERR, '>', "$prefix/$name.err"
+           or die "Can't open $prefix/$name.err: $!";
+       exec $^X, 'makedef.pl', @args;
+       die "Something went horribly wrong: $!";
+    }
+    die "Bad waitpid: $!" unless waitpid $pid, 0 == $pid;
+    if ($?) {
+       print STDERR "`$^X makedef.pl @args` failed with $?\n";
+       print STDERR "See output in $prefix/$name.err\n";
+       return 1;
+    }
+    return 0;
+}
+
+my $bad = expand([], [], @args);
+exit($bad > 255 ? 255 : $bad);