From: Nicholas Clark <nick@ccl4.org>
Date: Fri, 4 Jan 2008 18:18:02 +0000 (+0000)
Subject: Add a small program that gets the C pre-processor to expand the macro
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d1f3479f8c62266471eafb582091197ae2cf4cad;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
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 $_;
+}