From: Nicholas Clark <nick@ccl4.org>
Date: Sun, 17 Jul 2011 07:59:27 +0000 (+0100)
Subject: Add a utility to help test makedef.pl
X-Git-Tag: upstream/5.16.3~3163^2~109^2~69
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=e95aa0cbf5ce7c39ec487bb798ee06d4732fe257;p=platform%2Fupstream%2Fperl.git

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 d3e5632e0a..e304e9eb26 100644
--- 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
index 0000000000..35881920d5
--- /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);