This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make Porting/expand-macro.pl use $Config{make} instead of hardcoded `make`
[perl5.git] / Porting / expand-macro.pl
CommitLineData
d1f3479f
NC
1#!perl -w
2use strict;
3
d5f33267 4use Pod::Usage;
a93e78e3 5use Getopt::Std;
2c949eae 6use Config;
d5f33267 7$Getopt::Std::STANDARD_HELP_VERSION = 1;
a93e78e3 8
d5f33267
MHM
9my $trysource = "try.c";
10my $tryout = "try.i";
d1f3479f 11
8553b68c 12getopts('fF:ekvI:X', \my %opt) or pod2usage();
a93e78e3 13
d5f33267 14my($expr, @headers) = @ARGV ? splice @ARGV : "-";
d1f3479f 15
d5f33267 16pod2usage "-f and -F <tool> are exclusive\n" if $opt{f} and $opt{F};
a93e78e3 17
d1f3479f 18foreach($trysource, $tryout) {
a93e78e3 19 unlink $_ if $opt{e};
d1f3479f
NC
20 die "You already have a $_" if -e $_;
21}
22
d5f33267
MHM
23if ($expr eq '-') {
24 warn "reading from stdin...\n";
25 $expr = do { local $/; <> };
26}
27
28my($macro, $args) = $expr =~ /^\s*(\w+)((?:\s*\(.*\))?)\s*;?\s*$/s
29 or pod2usage "$expr doesn't look like a macro-name or macro-expression to me";
30
31if (!(@ARGV = @headers)) {
d1f3479f
NC
32 open my $fh, '<', 'MANIFEST' or die "Can't open MANIFEST: $!";
33 while (<$fh>) {
34 push @ARGV, $1 if m!^([^/]+\.h)\t!;
35 }
ed690650 36 push @ARGV, 'config.h' if -f 'config.h';
d1f3479f
NC
37}
38
be4f373d 39my $header;
d1f3479f 40while (<>) {
e25a7dc2 41 next unless /^#\s*define\s+$macro\b/;
d1f3479f 42 my ($def_args) = /^#\s*define\s+$macro\(([^)]*)\)/;
d5f33267 43 if (defined $def_args && !$args) {
d1f3479f 44 my @args = split ',', $def_args;
a93e78e3 45 print "# macro: $macro args: @args in $_\n" if $opt{v};
d1f3479f
NC
46 my $argname = "A0";
47 $args = '(' . join (', ', map {$argname++} 1..@args) . ')';
48 }
be4f373d 49 $header = $ARGV;
d1f3479f
NC
50 last;
51}
be4f373d 52die "$macro not found\n" unless defined $header;
d1f3479f
NC
53
54open my $out, '>', $trysource or die "Can't open $trysource: $!";
55
d5f33267
MHM
56my $sentinel = "$macro expands to";
57
8553b68c
NC
58my %done_header;
59
60sub do_header {
61 my $header = shift;
62 return if $done_header{$header}++;
63 print $out qq{#include "$header"\n};
64}
65
66print $out <<'EOF' if $opt{X};
67/* Need to do this like this, as cflags.sh sets it for us come what may. */
68#undef PERL_CORE
69
4784c5e8
NC
70EOF
71
8553b68c
NC
72do_header('EXTERN.h');
73do_header('perl.h');
74do_header($header);
75do_header('XSUB.h') if $opt{X};
4784c5e8
NC
76
77print $out <<"EOF";
be4f373d 78#line 4 "$sentinel"
d1f3479f
NC
79$macro$args
80EOF
81
82close $out or die "Can't close $trysource: $!";
83
2c949eae
MM
84print "doing: $Config{make} $tryout\n" if $opt{v};
85my $cmd = "$Config{make} $tryout";
86system( $cmd ) == 0
87 or die "Couldn't launch [$cmd]: $! / $?";
d1f3479f 88
a93e78e3 89# if user wants 'indent' formatting ..
27c6397c
NC
90my $out_fh;
91
92if ($opt{f} || $opt{F}) {
93 # a: indent is a well behaved filter when given 0 arguments, reading from
94 # stdin and writing to stdout
95 # b: all our braces should be balanced, indented back to column 0, in the
96 # headers, hence everything before our #line directive can be ignored
97 #
98 # We can take advantage of this to reduce the work to indent.
99
100 my $indent_command = $opt{f} ? 'indent' : $opt{F};
101
102 if (defined $opt{I}) {
103 $indent_command .= " $opt{I}";
104 }
105 open $out_fh, '|-', $indent_command or die $?;
106} else {
107 $out_fh = \*STDOUT;
108}
a93e78e3 109
d1f3479f
NC
110open my $fh, '<', $tryout or die "Can't open $tryout: $!";
111
112while (<$fh>) {
27c6397c 113 print $out_fh $_ if /$sentinel/o .. 1;
d1f3479f
NC
114}
115
a93e78e3
JC
116unless ($opt{k}) {
117 foreach($trysource, $tryout) {
118 die "Can't unlink $_" unless unlink $_;
119 }
d1f3479f 120}
d5f33267
MHM
121
122__END__
123
124=head1 NAME
125
126expand-macro.pl - expand C macros using the C preprocessor
127
128=head1 SYNOPSIS
129
130 expand-macro.pl [options] [ < macro-name | macro-expression | - > [headers] ]
131
132 options:
133 -f use 'indent' to format output
134 -F <tool> use <tool> to format output (instead of -f)
135 -e erase try.[ic] instead of failing when they're present (errdetect)
136 -k keep them after generating (for handy inspection)
137 -v verbose
138 -I <indent-opts> passed into indent
8553b68c 139 -X include "XSUB.h" (and undefine PERL_CORE)
d5f33267
MHM
140
141=cut