Add a small program that gets the C pre-processor to expand the macro

passed on the command line.

p4raw-id: //depot/perl@32833

diff --git a/MANIFEST b/MANIFEST
index b823f10..5dac47d 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3300,6 +3300,7 @@ Porting/Contract  Social contract for contributed modules in Perl core
 Porting/corecpan.pl    Reports outdated dual-lived modules
 Porting/corelist.pl    Generates data for Module::CoreList
 Porting/curliff.pl     Curliff or liff your curliffable files.
+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
 Porting/fixCORE                Find and fix modules that generate warnings

diff --git a/Porting/expand-macro.pl b/Porting/expand-macro.pl
new file mode 100644 (file)
index 0000000..624e7dc
--- /dev/null
+++ b/Porting/expand-macro.pl
@@ -0,0 +1,58 @@
+#!perl -w
+use strict;
+
+use vars qw($trysource $tryout $sentinel);
+$trysource = "try.c";
+$tryout = "try.i";
+
+my $macro = shift;
+die "$0 macro [headers]" unless defined $macro;
+
+$sentinel = "$macro expands to";
+
+foreach($trysource, $tryout) {
+    die "You already have a $_" if -e $_;
+}
+
+if (!@ARGV) {
+    open my $fh, '<', 'MANIFEST' or die "Can't open MANIFEST: $!";
+    while (<$fh>) {
+       push @ARGV, $1 if m!^([^/]+\.h)\t!;
+    }
+}
+
+my $args = '';
+
+while (<>) {
+    next unless /^#\s*define\s+$macro/;
+    my ($def_args) = /^#\s*define\s+$macro\(([^)]*)\)/;
+    if (defined $def_args) {
+       my @args = split ',', $def_args;
+       my $argname = "A0";
+       $args = '(' . join (', ', map {$argname++} 1..@args) . ')';
+    }
+    last;
+}
+
+open my $out, '>', $trysource or die "Can't open $trysource: $!";
+
+print $out <<"EOF";
+#include "EXTERN.h"
+#include "perl.h"
+#line 3 "$sentinel"
+$macro$args
+EOF
+
+close $out or die "Can't close $trysource: $!";
+
+system "make $tryout" and die;
+
+open my $fh, '<', $tryout or die "Can't open $tryout: $!";
+
+while (<$fh>) {
+    print if /$sentinel/o .. 1;
+}
+
+foreach($trysource, $tryout) {
+    die "Can't unlink $_" unless unlink $_;
+}