File: | /usr/local/bin/autom4te |
Coverage: | 77.4% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | #! /usr/bin/perl -w | ||||||
2 | # -*- perl -*- | ||||||
3 | # Generated from autom4te.in; do not edit by hand. | ||||||
4 | |||||||
5 | 2758 | 7171 | eval 'case $# in 0) exec /usr/bin/perl -S "$0";; *) exec /usr/bin/perl -S "$0" "$@";; esac' | ||||
6 | if 0; | ||||||
7 | |||||||
8 | # autom4te - Wrapper around M4 libraries. | ||||||
9 | # Copyright (C) 2001, 2002, 2003, 2005, 2006, 2007, 2008, 2009, 2010 | ||||||
10 | # Free Software Foundation, Inc. | ||||||
11 | |||||||
12 | # This program is free software: you can redistribute it and/or modify | ||||||
13 | # it under the terms of the GNU General Public License as published by | ||||||
14 | # the Free Software Foundation, either version 3 of the License, or | ||||||
15 | # (at your option) any later version. | ||||||
16 | |||||||
17 | # This program is distributed in the hope that it will be useful, | ||||||
18 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | ||||||
19 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||||||
20 | # GNU General Public License for more details. | ||||||
21 | |||||||
22 | # You should have received a copy of the GNU General Public License | ||||||
23 | # along with this program. If not, see <http://www.gnu.org/licenses/>. | ||||||
24 | |||||||
25 | |||||||
26 | BEGIN | ||||||
27 | { | ||||||
28 | 2758 | 52867 | my $pkgdatadir = $ENV{'autom4te_perllibdir'} || '/usr/local/share/autoconf'; | ||||
29 | 2758 | 8468 | unshift @INC, $pkgdatadir; | ||||
30 | |||||||
31 | # Override SHELL. On DJGPP SHELL may not be set to a shell | ||||||
32 | # that can handle redirection and quote arguments correctly, | ||||||
33 | # e.g.: COMMAND.COM. For DJGPP always use the shell that configure | ||||||
34 | # has detected. | ||||||
35 | 2758 | 12383 | $ENV{'SHELL'} = '/bin/sh' if ($^O eq 'dos'); | ||||
36 | } | ||||||
37 | |||||||
38 | 2758 2758 2758 | 33843 4131 20500 | use Autom4te::C4che; | ||||
39 | 2758 2758 2758 | 20478 3990 18171 | use Autom4te::ChannelDefs; | ||||
40 | 2758 2758 2758 | 11185 2900 19437 | use Autom4te::Channels; | ||||
41 | 2758 2758 2758 | 21969 4289 18994 | use Autom4te::FileUtils; | ||||
42 | 2758 2758 2758 | 25945 4437 19939 | use Autom4te::General; | ||||
43 | 2758 2758 2758 | 31629 3543 19984 | use Autom4te::XFile; | ||||
44 | 2758 2758 2758 | 11156 3180 7845 | use File::Basename; | ||||
45 | 2758 2758 2758 | 10478 7133 15065 | use strict; | ||||
46 | |||||||
47 | # Data directory. | ||||||
48 | 2758 | 21420 | my $pkgdatadir = $ENV{'AC_MACRODIR'} || '/usr/local/share/autoconf'; | ||||
49 | |||||||
50 | # $LANGUAGE{LANGUAGE} -- Automatic options for LANGUAGE. | ||||||
51 | 2758 | 3933 | my %language; | ||||
52 | |||||||
53 | 2758 | 4725 | my $output = '-'; | ||||
54 | |||||||
55 | # Mode of the output file except for traces. | ||||||
56 | 2758 | 4588 | my $mode = "0666"; | ||||
57 | |||||||
58 | # If melt, don't use frozen files. | ||||||
59 | 2758 | 4405 | my $melt = 0; | ||||
60 | |||||||
61 | # Names of the cache directory, cache directory index, trace cache | ||||||
62 | # prefix, and output cache prefix. And the IO object for the index. | ||||||
63 | 2758 | 3643 | my $cache; | ||||
64 | 2758 | 3417 | my $icache; | ||||
65 | 2758 | 3154 | my $tcache; | ||||
66 | 2758 | 3088 | my $ocache; | ||||
67 | 2758 | 3366 | my $icache_file; | ||||
68 | |||||||
69 | 2758 | 4157 | my $flock_implemented = 'yes'; | ||||
70 | |||||||
71 | # The macros to trace mapped to their format, as specified by the | ||||||
72 | # user. | ||||||
73 | 2758 | 3657 | my %trace; | ||||
74 | |||||||
75 | # The macros the user will want to trace in the future. | ||||||
76 | # We need `include' to get the included file, `m4_pattern_forbid' and | ||||||
77 | # `m4_pattern_allow' to check the output. | ||||||
78 | # | ||||||
79 | # FIXME: What about `sinclude'? | ||||||
80 | 2758 | 8949 | my @preselect = ('include', | ||||
81 | 'm4_pattern_allow', 'm4_pattern_forbid', | ||||||
82 | '_m4_warn'); | ||||||
83 | |||||||
84 | # M4 include path. | ||||||
85 | 2758 | 3596 | my @include; | ||||
86 | |||||||
87 | # Do we freeze? | ||||||
88 | 2758 | 4317 | my $freeze = 0; | ||||
89 | |||||||
90 | # $M4. | ||||||
91 | 2758 | 18369 | my $m4 = $ENV{"M4"} || '/usr/local/bin/m4'; | ||||
92 | # Some non-GNU m4's don't reject the --help option, so give them /dev/null. | ||||||
93 | 2758 | 21650216 | fatal "need GNU m4 1.4 or later: $m4" | ||||
94 | if system "$m4 --help </dev/null 2>&1 | grep reload-state >/dev/null"; | ||||||
95 | |||||||
96 | # Set some high recursion limit as the default limit, 250, has already | ||||||
97 | # been hit with AC_OUTPUT. Don't override the user's choice. | ||||||
98 | 2758 | 105230 | $m4 .= ' --nesting-limit=1024' | ||||
99 | if " $m4 " !~ / (--nesting-limit(=[0-9]+)?|-L[0-9]*) /; | ||||||
100 | |||||||
101 | |||||||
102 | # @M4_BUILTIN -- M4 builtins and a useful comment. | ||||||
103 | 2758 | 6469674 | my @m4_builtin = `echo dumpdef | $m4 2>&1 >/dev/null`; | ||||
104 | 2758 126868 126868 | 41164 203220 253649 | map { s/:.*//;s/\W// } @m4_builtin; | ||||
105 | |||||||
106 | |||||||
107 | # %M4_BUILTIN_ALTERNATE_NAME | ||||||
108 | # -------------------------- | ||||||
109 | # The builtins are renamed, e.g., `define' is renamed `m4_define'. | ||||||
110 | # So map `define' to `m4_define' and conversely. | ||||||
111 | # Some macros don't follow this scheme: be sure to properly map to their | ||||||
112 | # alternate name too. | ||||||
113 | # | ||||||
114 | # FIXME: Trace status of renamed builtins was fixed in M4 1.4.5, which | ||||||
115 | # we now depend on; do we still need to do this mapping? | ||||||
116 | # | ||||||
117 | # So we will merge them, i.e., tracing `BUILTIN' or tracing | ||||||
118 | # `m4_BUILTIN' will be the same: tracing both, but honoring the | ||||||
119 | # *last* trace specification. | ||||||
120 | # | ||||||
121 | # FIXME: This is not enough: in the output `$0' will be `BUILTIN' | ||||||
122 | # sometimes and `m4_BUILTIN' at others. We should return a unique name, | ||||||
123 | # the one specified by the user. | ||||||
124 | # | ||||||
125 | # FIXME: To be absolutely rigorous, I would say that given that we | ||||||
126 | # _redefine_ divert (instead of _copying_ it), divert and the like | ||||||
127 | # should not be part of this list. | ||||||
128 | 2758 | 18969 | my %m4_builtin_alternate_name; | ||||
129 | 126868 | 844997 | @m4_builtin_alternate_name{"$_", "m4_$_"} = ("m4_$_", "$_") | ||||
130 | 2758 2758 | 10540 11491 | foreach (grep { !/m4wrap|m4exit|dnl|ifelse|__.*__/ } @m4_builtin); | ||||
131 | 2758 | 24212 | @m4_builtin_alternate_name{"ifelse", "m4_if"} = ("m4_if", "ifelse"); | ||||
132 | 2758 | 13060 | @m4_builtin_alternate_name{"m4exit", "m4_exit"} = ("m4_exit", "m4exit"); | ||||
133 | 2758 | 12924 | @m4_builtin_alternate_name{"m4wrap", "m4_wrap"} = ("m4_wrap", "m4wrap"); | ||||
134 | |||||||
135 | |||||||
136 | # $HELP | ||||||
137 | # ----- | ||||||
138 | 2758 | 66045 | $help = "Usage: $0 [OPTION]... [FILES] | ||||
139 | |||||||
140 | Run GNU M4 on the FILES, avoiding useless runs. Output the traces if tracing, | ||||||
141 | the frozen file if freezing, otherwise the expansion of the FILES. | ||||||
142 | |||||||
143 | If some of the FILES are named \`FILE.m4f\' they are considered to be M4 | ||||||
144 | frozen files of all the previous files (which are therefore not loaded). | ||||||
145 | If \`FILE.m4f\' is not found, then \`FILE.m4\' will be used, together with | ||||||
146 | all the previous files. | ||||||
147 | |||||||
148 | Some files may be optional, i.e., will only be processed if found in the | ||||||
149 | include path, but then must end in \`.m4?\'; the question mark is not part of | ||||||
150 | the actual file name. | ||||||
151 | |||||||
152 | Operation modes: | ||||||
153 | -h, --help print this help, then exit | ||||||
154 | -V, --version print version number, then exit | ||||||
155 | -v, --verbose verbosely report processing | ||||||
156 | -d, --debug don\'t remove temporary files | ||||||
157 | -o, --output=FILE save output in FILE (defaults to \`-\', stdout) | ||||||
158 | -f, --force don\'t rely on cached values | ||||||
159 | -W, --warnings=CATEGORY report the warnings falling in CATEGORY | ||||||
160 | -l, --language=LANG specify the set of M4 macros to use | ||||||
161 | -C, --cache=DIRECTORY preserve results for future runs in DIRECTORY | ||||||
162 | --no-cache disable the cache | ||||||
163 | -m, --mode=OCTAL change the non trace output file mode (0666) | ||||||
164 | -M, --melt don\'t use M4 frozen files | ||||||
165 | |||||||
166 | Languages include: | ||||||
167 | \`Autoconf\' create Autoconf configure scripts | ||||||
168 | \`Autotest\' create Autotest test suites | ||||||
169 | \`M4sh\' create M4sh shell scripts | ||||||
170 | \`M4sugar\' create M4sugar output | ||||||
171 | |||||||
172 | " . Autom4te::ChannelDefs::usage . " | ||||||
173 | |||||||
174 | The environment variables \`M4\' and \`WARNINGS\' are honored. | ||||||
175 | |||||||
176 | Library directories: | ||||||
177 | -B, --prepend-include=DIR prepend directory DIR to search path | ||||||
178 | -I, --include=DIR append directory DIR to search path | ||||||
179 | |||||||
180 | Tracing: | ||||||
181 | -t, --trace=MACRO[:FORMAT] report the MACRO invocations | ||||||
182 | -p, --preselect=MACRO prepare to trace MACRO in a future run | ||||||
183 | |||||||
184 | Freezing: | ||||||
185 | -F, --freeze produce an M4 frozen state file for FILES | ||||||
186 | |||||||
187 | FORMAT defaults to \`\$f:\$l:\$n:\$%\', and can use the following escapes: | ||||||
188 | \$\$ literal \$ | ||||||
189 | \$f file where macro was called | ||||||
190 | \$l line where macro was called | ||||||
191 | \$d nesting depth of macro call | ||||||
192 | \$n name of the macro | ||||||
193 | \$NUM argument NUM, unquoted and with newlines | ||||||
194 | \$SEP\@ all arguments, with newlines, quoted, and separated by SEP | ||||||
195 | \$SEP* all arguments, with newlines, unquoted, and separated by SEP | ||||||
196 | \$SEP% all arguments, without newlines, unquoted, and separated by SEP | ||||||
197 | SEP can be empty for the default (comma for \@ and *, colon for %), | ||||||
198 | a single character for that character, or {STRING} to use a string. | ||||||
199 | |||||||
200 | Report bugs to <bug-autoconf\@gnu.org>. | ||||||
201 | GNU Autoconf home page: <http://www.gnu.org/software/autoconf/>. | ||||||
202 | General help using GNU software: <http://www.gnu.org/gethelp/>. | ||||||
203 | "; | ||||||
204 | |||||||
205 | # $VERSION | ||||||
206 | # -------- | ||||||
207 | 2758 | 9219 | $version = <<"EOF"; | ||||
208 | autom4te (GNU Autoconf) 2.68 | ||||||
209 | Copyright (C) 2010 Free Software Foundation, Inc. | ||||||
210 | License GPLv3+/Autoconf: GNU GPL version 3 or later | ||||||
211 | <http://gnu.org/licenses/gpl.html>, <http://gnu.org/licenses/exceptions.html> | ||||||
212 | This is free software: you are free to change and redistribute it. | ||||||
213 | There is NO WARRANTY, to the extent permitted by law. | ||||||
214 | |||||||
215 | Written by Akim Demaille. | ||||||
216 | EOF | ||||||
217 | |||||||
218 | |||||||
219 | ## ---------- ## | ||||||
220 | ## Routines. ## | ||||||
221 | ## ---------- ## | ||||||
222 | |||||||
223 | |||||||
224 | # $OPTION | ||||||
225 | # files_to_options (@FILE) | ||||||
226 | # ------------------------ | ||||||
227 | # Transform Autom4te conventions (e.g., using foo.m4f to designate a frozen | ||||||
228 | # file) into a suitable command line for M4 (e.g., using --reload-state). | ||||||
229 | # parse_args guarantees that we will see at most one frozen file, and that | ||||||
230 | # if a frozen file is present, it is the first argument. | ||||||
231 | sub files_to_options (@) | ||||||
232 | { | ||||||
233 | 2025 | 10486 | my (@file) = @_; | ||||
234 | 2025 | 2928 | my @res; | ||||
235 | 2025 | 6718 | foreach my $file (@file) | ||||
236 | { | ||||||
237 | 23628 | 46577 | my $arg = shell_quote ($file); | ||||
238 | 23628 | 52595 | if ($file =~ /\.m4f$/) | ||||
239 | { | ||||||
240 | 2024 | 5388 | $arg = "--reload-state=$arg"; | ||||
241 | # If the user downgraded M4 from 1.6 to 1.4.x after freezing | ||||||
242 | # the file, then we ensure the frozen __m4_version__ will | ||||||
243 | # not cause m4_init to make the wrong decision about the | ||||||
244 | # current M4 version. | ||||||
245 | 93104 | 180191 | $arg .= " --undefine=__m4_version__" | ||||
246 | 2024 | 7861 | unless grep {/__m4_version__/} @m4_builtin; | ||||
247 | } | ||||||
248 | 23628 | 44868 | push @res, $arg; | ||||
249 | } | ||||||
250 | 2025 | 26769 | return join ' ', @res; | ||||
251 | } | ||||||
252 | |||||||
253 | |||||||
254 | # load_configuration ($FILE) | ||||||
255 | # -------------------------- | ||||||
256 | # Load the configuration $FILE. | ||||||
257 | sub load_configuration ($) | ||||||
258 | { | ||||||
259 | 2767 | 12430 | my ($file) = @_; | ||||
260 | 2758 2758 2758 | 23991 3244 16302 | use Text::ParseWords; | ||||
261 | |||||||
262 | 2767 | 31951 | my $cfg = new Autom4te::XFile ("< " . open_quote ($file)); | ||||
263 | 2767 | 5552 | my $lang; | ||||
264 | 2767 | 18229 | while ($_ = $cfg->getline) | ||||
265 | { | ||||||
266 | 452366 | 512792 | chomp; | ||||
267 | # Comments. | ||||||
268 | next | ||||||
269 | 452366 | 1731060 | if /^\s*(\#.*)?$/; | ||||
270 | |||||||
271 | 262064 | 565808 | my @words = shellwords ($_); | ||||
272 | 262064 | 34688091 | my $type = shift @words; | ||||
273 | 262064 | 808156 | if ($type eq 'begin-language:') | ||||
274 | { | ||||||
275 | 22082 | 44739 | fatal "$file:$.: end-language missing for: $lang" | ||||
276 | if defined $lang; | ||||||
277 | 22082 | 79270 | $lang = lc $words[0]; | ||||
278 | } | ||||||
279 | elsif ($type eq 'end-language:') | ||||||
280 | { | ||||||
281 | 22082 | 55373 | error "$file:$.: end-language mismatch: $lang" | ||||
282 | if $lang ne lc $words[0]; | ||||||
283 | 22082 | 69313 | $lang = undef; | ||||
284 | } | ||||||
285 | elsif ($type eq 'args:') | ||||||
286 | { | ||||||
287 | 217900 | 394354 | fatal "$file:$.: no current language" | ||||
288 | unless defined $lang; | ||||||
289 | 217900 217900 | 198236 1027003 | push @{$language{$lang}}, @words; | ||||
290 | } | ||||||
291 | else | ||||||
292 | { | ||||||
293 | 0 | 0 | error "$file:$.: unknown directive: $type"; | ||||
294 | } | ||||||
295 | } | ||||||
296 | } | ||||||
297 | |||||||
298 | |||||||
299 | # parse_args () | ||||||
300 | # ------------- | ||||||
301 | # Process any command line arguments. | ||||||
302 | sub parse_args () | ||||||
303 | { | ||||||
304 | # We want to look for the early options, which should not be found | ||||||
305 | # in the configuration file. Prepend to the user arguments. | ||||||
306 | # Perform this repeatedly so that we can use --language in language | ||||||
307 | # definitions. Beware that there can be several --language | ||||||
308 | # invocations. | ||||||
309 | 2758 | 4630 | my @language; | ||||
310 | 2758 | 4927 | do { | ||||
311 | 12767 | 20125 | @language = (); | ||||
312 | 2758 2758 2758 | 12744 2980 10867 | use Getopt::Long; | ||||
313 | 12767 | 51889 | Getopt::Long::Configure ("pass_through", "permute"); | ||||
314 | 12767 | 1102379 | GetOptions ("l|language=s" => \@language); | ||||
315 | |||||||
316 | 12767 | 76150171 | foreach (@language) | ||||
317 | { | ||||||
318 | 15214 | 43053 | error "unknown language: $_" | ||||
319 | unless exists $language{lc $_}; | ||||||
320 | 15214 15214 | 19564 123762 | unshift @ARGV, @{$language{lc $_}}; | ||||
321 | } | ||||||
322 | } while @language; | ||||||
323 | |||||||
324 | # --debug is useless: it is parsed below. | ||||||
325 | 2758 | 12153 | if (exists $ENV{'AUTOM4TE_DEBUG'}) | ||||
326 | { | ||||||
327 | 0 | 0 | print STDERR "$me: concrete arguments:\n"; | ||||
328 | 0 | 0 | foreach my $arg (@ARGV) | ||||
329 | { | ||||||
330 | 0 | 0 | print STDERR "| $arg\n"; | ||||
331 | } | ||||||
332 | } | ||||||
333 | |||||||
334 | # Process the arguments for real this time. | ||||||
335 | 2758 | 7050 | my @trace; | ||||
336 | 2758 | 3963 | my @prepend_include; | ||||
337 | 2758 | 21367 | parse_WARNINGS; | ||||
338 | getopt | ||||||
339 | ( | ||||||
340 | # Operation modes: | ||||||
341 | "o|output=s" => \$output, | ||||||
342 | "W|warnings=s" => \&parse_warnings, | ||||||
343 | "m|mode=s" => \$mode, | ||||||
344 | "M|melt" => \$melt, | ||||||
345 | |||||||
346 | # Library directories: | ||||||
347 | "B|prepend-include=s" => \@prepend_include, | ||||||
348 | "I|include=s" => \@include, | ||||||
349 | |||||||
350 | # Tracing: | ||||||
351 | # Using a hash for traces is seducing. Unfortunately, upon `-t FOO', | ||||||
352 | # instead of mapping `FOO' to undef, Getopt maps it to `1', preventing | ||||||
353 | # us from distinguishing `-t FOO' from `-t FOO=1'. So let's do it | ||||||
354 | # by hand. | ||||||
355 | "t|trace=s" => \@trace, | ||||||
356 | "p|preselect=s" => \@preselect, | ||||||
357 | |||||||
358 | # Freezing. | ||||||
359 | "F|freeze" => \$freeze, | ||||||
360 | |||||||
361 | # Caching. | ||||||
362 | "C|cache=s" => \$cache, | ||||||
363 | 17 | 104985 | "no-cache" => sub { $cache = undef; }, | ||||
364 | 2758 | 50629 | ); | ||||
365 | |||||||
366 | 2758 | 13542 | fatal "too few arguments | ||||
367 | Try `$me --help' for more information." | ||||||
368 | unless @ARGV; | ||||||
369 | |||||||
370 | # Freezing: | ||||||
371 | # We cannot trace at the same time (well, we can, but it sounds insane). | ||||||
372 | # And it implies melting: there is risk not to update properly using | ||||||
373 | # old frozen files, and worse yet: we could load a frozen file and | ||||||
374 | # refreeze it! A sort of caching :) | ||||||
375 | 2758 | 10597 | fatal "cannot freeze and trace" | ||||
376 | if $freeze && @trace; | ||||||
377 | 2758 | 7190 | $melt = 1 | ||||
378 | if $freeze; | ||||||
379 | |||||||
380 | # Names of the cache directory, cache directory index, trace cache | ||||||
381 | # prefix, and output cache prefix. If the cache is not to be | ||||||
382 | # preserved, default to a temporary directory (automatically removed | ||||||
383 | # on exit). | ||||||
384 | 2758 | 7643 | $cache = $tmp | ||||
385 | unless $cache; | ||||||
386 | 2758 | 6527 | $icache = "$cache/requests"; | ||||
387 | 2758 | 5492 | $tcache = "$cache/traces."; | ||||
388 | 2758 | 5384 | $ocache = "$cache/output."; | ||||
389 | |||||||
390 | # Normalize the includes: the first occurrence is enough, several is | ||||||
391 | # a pain since it introduces a useless difference in the path which | ||||||
392 | # invalidates the cache. And strip `.' which is implicit and always | ||||||
393 | # first. | ||||||
394 | 2758 2758 | 19008 15887 | @include = grep { !/^\.$/ } uniq (reverse(@prepend_include), @include); | ||||
395 | |||||||
396 | # Convert @trace to %trace, and work around the M4 builtins tracing | ||||||
397 | # problem. | ||||||
398 | # The default format is `$f:$l:$n:$%'. | ||||||
399 | 2758 | 8128 | foreach (@trace) | ||||
400 | { | ||||||
401 | 76791 | 187565 | /^([^:]+)(?::(.*))?$/ms; | ||||
402 | 76791 | 259231 | $trace{$1} = defined $2 ? $2 : '$f:$l:$n:$%'; | ||||
403 | 76791 | 202013 | $trace{$m4_builtin_alternate_name{$1}} = $trace{$1} | ||||
404 | if exists $m4_builtin_alternate_name{$1}; | ||||||
405 | } | ||||||
406 | |||||||
407 | # Work around the M4 builtins tracing problem for @PRESELECT. | ||||||
408 | # FIXME: Is this still needed, now that we rely on M4 1.4.5? | ||||||
409 | 6228 | 15294 | push (@preselect, | ||||
410 | 106457 | 173318 | map { $m4_builtin_alternate_name{$_} } | ||||
411 | 2758 | 8632 | grep { exists $m4_builtin_alternate_name{$_} } @preselect); | ||||
412 | |||||||
413 | # If we find frozen files, then all the files before it are | ||||||
414 | # discarded: the frozen file is supposed to include them all. | ||||||
415 | # | ||||||
416 | # We don't want to depend upon m4's --include to find the top level | ||||||
417 | # files, so we use `find_file' here. Try to get a canonical name, | ||||||
418 | # as it's part of the key for caching. And some files are optional | ||||||
419 | # (also handled by `find_file'). | ||||||
420 | 2758 | 9626 | my @argv; | ||||
421 | 2758 | 7397 | foreach (@ARGV) | ||||
422 | { | ||||||
423 | 34512 | 99934 | if ($_ eq '-') | ||||
424 | { | ||||||
425 | 0 | 0 | push @argv, $_; | ||||
426 | } | ||||||
427 | elsif (/\.m4f$/) | ||||||
428 | { | ||||||
429 | # Frozen files are optional => pass a `?' to `find_file'. | ||||||
430 | 8274 | 34484 | my $file = find_file ("$_?", @include); | ||||
431 | 8274 | 51021 | if (!$melt && $file) | ||||
432 | { | ||||||
433 | 8268 | 20618 | @argv = ($file); | ||||
434 | } | ||||||
435 | else | ||||||
436 | { | ||||||
437 | 6 | 16 | s/\.m4f$/.m4/; | ||||
438 | 6 | 16 | push @argv, find_file ($_, @include); | ||||
439 | } | ||||||
440 | } | ||||||
441 | else | ||||||
442 | { | ||||||
443 | 26238 | 59308 | my $file = find_file ($_, @include); | ||||
444 | 26238 | 672549 | push @argv, $file | ||||
445 | if $file; | ||||||
446 | } | ||||||
447 | } | ||||||
448 | 2758 | 22876 | @ARGV = @argv; | ||||
449 | } | ||||||
450 | |||||||
451 | |||||||
452 | # handle_m4 ($REQ, @MACRO) | ||||||
453 | # ------------------------ | ||||||
454 | # Run m4 on the input files, and save the traces on the @MACRO. | ||||||
455 | sub handle_m4 ($@) | ||||||
456 | { | ||||||
457 | 2025 | 19968 | my ($req, @macro) = @_; | ||||
458 | |||||||
459 | # GNU m4 appends when using --debugfile/--error-output. | ||||||
460 | 2025 | 6236 | unlink ($tcache . $req->id . "t"); | ||||
461 | |||||||
462 | # Run m4. | ||||||
463 | # | ||||||
464 | # We don't output directly to the cache files, to avoid problems | ||||||
465 | # when we are interrupted (that leaves corrupted files). | ||||||
466 | 2025 | 8787 | xsystem ("$m4 --gnu" | ||||
467 | 101082 | 185840 | . join (' --include=', '', map { shell_quote ($_) } @include) | ||||
468 | . ' --debug=aflq' | ||||||
469 | . (!exists $ENV{'AUTOM4TE_NO_FATAL'} ? ' --fatal-warning' : '') | ||||||
470 | . " --debugfile=" . shell_quote ("$tcache" . $req->id . "t") | ||||||
471 | 2025 | 10497 | . join (' --trace=', '', map { shell_quote ($_) } sort @macro) | ||||
472 | . " " . files_to_options (@ARGV) | ||||||
473 | . " > " . shell_quote ("$ocache" . $req->id . "t")); | ||||||
474 | |||||||
475 | # Everything went ok: preserve the outputs. | ||||||
476 | 2009 4018 | 76626 35069 | foreach my $file (map { $_ . $req->id } ($tcache, $ocache)) | ||||
477 | { | ||||||
478 | 2758 2758 2758 | 12782 3136 18647 | use File::Copy; | ||||
479 | 4018 | 272641 | move ("${file}t", "$file") | ||||
480 | or fatal "cannot rename ${file}t as $file: $!"; | ||||||
481 | } | ||||||
482 | } | ||||||
483 | |||||||
484 | |||||||
485 | # warn_forbidden ($WHERE, $WORD, %FORBIDDEN) | ||||||
486 | # ------------------------------------------ | ||||||
487 | # $WORD is forbidden. Warn with a dedicated error message if in | ||||||
488 | # %FORBIDDEN, otherwise a simple `error: possibly undefined macro' | ||||||
489 | # will do. | ||||||
490 | 2758 | 6616 | my $first_warn_forbidden = 1; | ||||
491 | sub warn_forbidden ($$%) | ||||||
492 | { | ||||||
493 | 0 | 0 | my ($where, $word, %forbidden) = @_; | ||||
494 | 0 | 0 | my $message; | ||||
495 | |||||||
496 | 0 | 0 | for my $re (sort keys %forbidden) | ||||
497 | { | ||||||
498 | 0 | 0 | if ($word =~ $re) | ||||
499 | { | ||||||
500 | 0 | 0 | $message = $forbidden{$re}; | ||||
501 | 0 | 0 | last; | ||||
502 | } | ||||||
503 | } | ||||||
504 | 0 | 0 | $message ||= "possibly undefined macro: $word"; | ||||
505 | 0 | 0 | warn "$where: error: $message\n"; | ||||
506 | 0 | 0 | if ($first_warn_forbidden) | ||||
507 | { | ||||||
508 | 0 | 0 | warn <<EOF; | ||||
509 | If this token and others are legitimate, please use m4_pattern_allow. | ||||||
510 | See the Autoconf documentation. | ||||||
511 | EOF | ||||||
512 | 0 | 0 | $first_warn_forbidden = 0; | ||||
513 | } | ||||||
514 | } | ||||||
515 | |||||||
516 | |||||||
517 | # handle_output ($REQ, $OUTPUT) | ||||||
518 | # ----------------------------- | ||||||
519 | # Run m4 on the input files, perform quadrigraphs substitution, check for | ||||||
520 | # forbidden tokens, and save into $OUTPUT. | ||||||
521 | sub handle_output ($$) | ||||||
522 | { | ||||||
523 | 580 | 1931 | my ($req, $output) = @_; | ||||
524 | |||||||
525 | 580 | 2325 | verb "creating $output"; | ||||
526 | |||||||
527 | # Load the forbidden/allowed patterns. | ||||||
528 | 580 | 3983 | handle_traces ($req, "$tmp/patterns", | ||||
529 | ('m4_pattern_forbid' => 'forbid:$1:$2', | ||||||
530 | 'm4_pattern_allow' => 'allow:$1')); | ||||||
531 | 580 | 5861 | my @patterns = new Autom4te::XFile ("< " . open_quote ("$tmp/patterns"))->getlines; | ||||
532 | 580 | 8699 | chomp @patterns; | ||||
533 | 54761 | 87080 | my %forbidden = | ||||
534 | 580 | 1911 | map { /^forbid:([^:]+):.+$/ => /^forbid:[^:]+:(.+)$/ } @patterns; | ||||
535 | 580 54761 | 1864 68539 | my $forbidden = join ('|', map { /^forbid:([^:]+)/ } @patterns) || "^\$"; | ||||
536 | 580 54761 | 1776 114756 | my $allowed = join ('|', map { /^allow:([^:]+)/ } @patterns) || "^\$"; | ||||
537 | |||||||
538 | 580 | 7668 | verb "forbidden tokens: $forbidden"; | ||||
539 | verb "forbidden token : $_ => $forbidden{$_}" | ||||||
540 | 580 580 | 1335 5799 | foreach (sort keys %forbidden); | ||||
541 | 580 | 3221 | verb "allowed tokens: $allowed"; | ||||
542 | |||||||
543 | # Read the (cached) raw M4 output, produce the actual result. We | ||||||
544 | # have to use the 2nd arg to have Autom4te::XFile honor the third, but then | ||||||
545 | # stdout is to be handled by hand :(. Don't use fdopen as it means | ||||||
546 | # we will close STDOUT, which we already do in END. | ||||||
547 | 580 | 3213 | my $out = new Autom4te::XFile; | ||||
548 | 580 | 3296 | if ($output eq '-') | ||||
549 | { | ||||||
550 | 0 | 0 | $out->open (">$output"); | ||||
551 | } | ||||||
552 | else | ||||||
553 | { | ||||||
554 | 580 | 5053 | $out->open($output, O_CREAT | O_WRONLY | O_TRUNC, oct ($mode)); | ||||
555 | } | ||||||
556 | 580 | 2368 | fatal "cannot create $output: $!" | ||||
557 | unless $out; | ||||||
558 | 580 | 4953 | my $in = new Autom4te::XFile ("< " . open_quote ($ocache . $req->id)); | ||||
559 | |||||||
560 | 580 | 1227 | my %prohibited; | ||||
561 | 580 | 896 | my $res; | ||||
562 | 580 | 2118 | while ($_ = $in->getline) | ||||
563 | { | ||||||
564 | 2626856 | 6659763 | s/\s+$//; | ||||
565 | 2626856 | 2743553 | s/__oline__/$./g; | ||||
566 | 2626856 | 2516262 | s/\@<:\@/[/g; | ||||
567 | 2626856 | 2481761 | s/\@:>\@/]/g; | ||||
568 | 2626856 | 2429611 | s/\@\{:\@/(/g; | ||||
569 | 2626856 | 2422376 | s/\@:\}\@/)/g; | ||||
570 | 2626856 | 2429673 | s/\@S\|\@/\$/g; | ||||
571 | 2626856 | 2483274 | s/\@%:\@/#/g; | ||||
572 | |||||||
573 | 2626856 | 2889070 | $res = $_; | ||||
574 | |||||||
575 | # Don't complain in comments. Well, until we have something | ||||||
576 | # better, don't consider `#include' etc. are comments. | ||||||
577 | 2626856 | 5644471 | s/\#.*// | ||||
578 | unless /^\#\s*(if|include|endif|ifdef|ifndef|define)\b/; | ||||||
579 | 2626856 | 9207276 | foreach (split (/\W+/)) | ||||
580 | { | ||||||
581 | 8354783 | 60628672 | $prohibited{$_} = $. | ||||
582 | if !/^$/ && /$forbidden/o && !/$allowed/o && ! exists $prohibited{$_}; | ||||||
583 | } | ||||||
584 | |||||||
585 | # Performed *last*: the empty quadrigraph. | ||||||
586 | 2626856 | 4092244 | $res =~ s/\@&t\@//g; | ||||
587 | |||||||
588 | 2626856 | 9407144 | print $out "$res\n"; | ||||
589 | } | ||||||
590 | |||||||
591 | 580 | 3919 | $out->close(); | ||||
592 | |||||||
593 | # If no forbidden words, we're done. | ||||||
594 | return | ||||||
595 | 580 | 37570 | if ! %prohibited; | ||||
596 | |||||||
597 | # Locate the forbidden words in the last input file. | ||||||
598 | # This is unsatisfying but... | ||||||
599 | 0 | 0 | $exit_code = 1; | ||||
600 | 0 | 0 | if ($ARGV[$#ARGV] ne '-') | ||||
601 | { | ||||||
602 | 0 | 0 | my $prohibited = '\b(' . join ('|', keys %prohibited) . ')\b'; | ||||
603 | 0 | 0 | my $file = new Autom4te::XFile ("< " . open_quote ($ARGV[$#ARGV])); | ||||
604 | |||||||
605 | 0 | 0 | while ($_ = $file->getline) | ||||
606 | { | ||||||
607 | # Don't complain in comments. Well, until we have something | ||||||
608 | # better, don't consider `#include' etc. to be comments. | ||||||
609 | 0 | 0 | s/\#.*// | ||||
610 | unless /^\#(if|include|endif|ifdef|ifndef|define)\b/; | ||||||
611 | |||||||
612 | # Complain once per word, but possibly several times per line. | ||||||
613 | 0 | 0 | while (/$prohibited/) | ||||
614 | { | ||||||
615 | 0 | 0 | my $word = $1; | ||||
616 | 0 | 0 | warn_forbidden ("$ARGV[$#ARGV]:$.", $word, %forbidden); | ||||
617 | 0 | 0 | delete $prohibited{$word}; | ||||
618 | # If we're done, exit. | ||||||
619 | return | ||||||
620 | 0 | 0 | if ! %prohibited; | ||||
621 | 0 | 0 | $prohibited = '\b(' . join ('|', keys %prohibited) . ')\b'; | ||||
622 | } | ||||||
623 | } | ||||||
624 | } | ||||||
625 | 0 | 0 | warn_forbidden ("$output:$prohibited{$_}", $_, %forbidden) | ||||
626 | 0 0 | 0 0 | foreach (sort { $prohibited{$a} <=> $prohibited{$b} } keys %prohibited); | ||||
627 | } | ||||||
628 | |||||||
629 | |||||||
630 | ## --------------------- ## | ||||||
631 | ## Handling the traces. ## | ||||||
632 | ## --------------------- ## | ||||||
633 | |||||||
634 | |||||||
635 | # $M4_MACRO | ||||||
636 | # trace_format_to_m4 ($FORMAT) | ||||||
637 | # ---------------------------- | ||||||
638 | # Convert a trace $FORMAT into a M4 trace processing macro's body. | ||||||
639 | sub trace_format_to_m4 ($) | ||||||
640 | { | ||||||
641 | 83104 | 132510 | my ($format) = @_; | ||||
642 | 83104 | 93233 | my $underscore = $_; | ||||
643 | 83104 | 296423 | my %escape = (# File name. | ||||
644 | 'f' => '$1', | ||||||
645 | # Line number. | ||||||
646 | 'l' => '$2', | ||||||
647 | # Depth. | ||||||
648 | 'd' => '$3', | ||||||
649 | # Name (also available as $0). | ||||||
650 | 'n' => '$4', | ||||||
651 | # Escaped dollar. | ||||||
652 | '$' => '$'); | ||||||
653 | |||||||
654 | 83104 | 88918 | my $res = ''; | ||||
655 | 83104 | 116664 | $_ = $format; | ||||
656 | 83104 | 153245 | while ($_) | ||||
657 | { | ||||||
658 | # $n -> $(n + 4) | ||||||
659 | 496831 | 2287786 | if (s/^\$(\d+)//) | ||||
660 | { | ||||||
661 | 15785 | 132266 | $res .= "\$" . ($1 + 4); | ||||
662 | } | ||||||
663 | # $x, no separator given. | ||||||
664 | elsif (s/^\$([fldn\$])//) | ||||||
665 | { | ||||||
666 | 234951 | 656658 | $res .= $escape{$1}; | ||||
667 | } | ||||||
668 | # $.x or ${sep}x. | ||||||
669 | elsif (s/^\$\{([^}]*)\}([@*%])// | ||||||
670 | || s/^\$(.?)([@*%])//) | ||||||
671 | { | ||||||
672 | # $@, list of quoted effective arguments. | ||||||
673 | 37257 | 155191 | if ($2 eq '@') | ||||
674 | { | ||||||
675 | 0 | 0 | $res .= ']at_at([' . ($1 ? $1 : ',') . '], $@)['; | ||||
676 | } | ||||||
677 | # $*, list of unquoted effective arguments. | ||||||
678 | elsif ($2 eq '*') | ||||||
679 | { | ||||||
680 | 0 | 0 | $res .= ']at_star([' . ($1 ? $1 : ',') . '], $@)['; | ||||
681 | } | ||||||
682 | # $%, list of flattened unquoted effective arguments. | ||||||
683 | elsif ($2 eq '%') | ||||||
684 | { | ||||||
685 | 37257 | 146670 | $res .= ']at_percent([' . ($1 ? $1 : ':') . '], $@)['; | ||||
686 | } | ||||||
687 | } | ||||||
688 | elsif (/^(\$.)/) | ||||||
689 | { | ||||||
690 | 0 | 0 | error "invalid escape: $1"; | ||||
691 | } | ||||||
692 | else | ||||||
693 | { | ||||||
694 | 208838 | 382245 | s/^([^\$]+)//; | ||||
695 | 208838 | 524586 | $res .= $1; | ||||
696 | } | ||||||
697 | } | ||||||
698 | |||||||
699 | 83104 | 100362 | $_ = $underscore; | ||||
700 | 83104 | 350211 | return '[[' . $res . ']]'; | ||||
701 | } | ||||||
702 | |||||||
703 | |||||||
704 | # handle_traces($REQ, $OUTPUT, %TRACE) | ||||||
705 | # ------------------------------------ | ||||||
706 | # We use M4 itself to process the traces. But to avoid name clashes when | ||||||
707 | # processing the traces, the builtins are disabled, and moved into `at_'. | ||||||
708 | # Actually, all the low level processing macros are in `at_' (and `_at_'). | ||||||
709 | # To avoid clashes between user macros and `at_' macros, the macros which | ||||||
710 | # implement tracing are in `AT_'. | ||||||
711 | # | ||||||
712 | # Having $REQ is needed to neutralize the macros which have been traced, | ||||||
713 | # but are not wanted now. | ||||||
714 | sub handle_traces ($$%) | ||||||
715 | { | ||||||
716 | 6332 | 84822 | my ($req, $output, %trace) = @_; | ||||
717 | |||||||
718 | 6332 | 119947 | verb "formatting traces for `$output': " . join (', ', sort keys %trace); | ||||
719 | |||||||
720 | # Processing the traces. | ||||||
721 | 6332 | 45836 | my $trace_m4 = new Autom4te::XFile ("> " . open_quote ("$tmp/traces.m4")); | ||||
722 | |||||||
723 | 6332 | 33473 | $_ = <<'EOF'; | ||||
724 | divert(-1) | ||||||
725 | changequote([, ]) | ||||||
726 | # _at_MODE(SEPARATOR, ELT1, ELT2...) | ||||||
727 | # ---------------------------------- | ||||||
728 | # List the elements, separating then with SEPARATOR. | ||||||
729 | # MODE can be: | ||||||
730 | # `at' -- the elements are enclosed in brackets. | ||||||
731 | # `star' -- the elements are listed as are. | ||||||
732 | # `percent' -- the elements are `flattened': spaces are singled out, | ||||||
733 | # and no new line remains. | ||||||
734 | define([_at_at], | ||||||
735 | [at_ifelse([$#], [1], [], | ||||||
736 | [$#], [2], [[[$2]]], | ||||||
737 | [[[$2]][$1]$0([$1], at_shift(at_shift($@)))])]) | ||||||
738 | |||||||
739 | define([_at_percent], | ||||||
740 | [at_ifelse([$#], [1], [], | ||||||
741 | [$#], [2], [at_flatten([$2])], | ||||||
742 | [at_flatten([$2])[$1]$0([$1], at_shift(at_shift($@)))])]) | ||||||
743 | |||||||
744 | define([_at_star], | ||||||
745 | [at_ifelse([$#], [1], [], | ||||||
746 | [$#], [2], [[$2]], | ||||||
747 | [[$2][$1]$0([$1], at_shift(at_shift($@)))])]) | ||||||
748 | |||||||
749 | # FLATTEN quotes its result. | ||||||
750 | # Note that the second pattern is `newline, tab or space'. Don't lose | ||||||
751 | # the tab! | ||||||
752 | define([at_flatten], | ||||||
753 | [at_patsubst(at_patsubst([[[$1]]], [\\\n]), [[\n\t ]+], [ ])]) | ||||||
754 | |||||||
755 | define([at_args], [at_shift(at_shift(at_shift(at_shift(at_shift($@)))))]) | ||||||
756 | define([at_at], [_$0([$1], at_args($@))]) | ||||||
757 | define([at_percent], [_$0([$1], at_args($@))]) | ||||||
758 | define([at_star], [_$0([$1], at_args($@))]) | ||||||
759 | |||||||
760 | EOF | ||||||
761 | 6332 6332 6332 | 96556 32366 25961 | s/^ //mg;s/\\t/\t/mg;s/\\n/\n/mg; | ||||
762 | 6332 | 47800 | print $trace_m4 $_; | ||||
763 | |||||||
764 | # If you trace `define', then on `define([m4_exit], defn([m4exit])' you | ||||||
765 | # will produce | ||||||
766 | # | ||||||
767 | # AT_define([m4sugar.m4], [115], [1], [define], [m4_exit], <m4exit>) | ||||||
768 | # | ||||||
769 | # Since `<m4exit>' is not quoted, the outer m4, when processing | ||||||
770 | # `trace.m4' will exit prematurely. Hence, move all the builtins to | ||||||
771 | # the `at_' name space. | ||||||
772 | |||||||
773 | 6332 | 12940 | print $trace_m4 "# Copy the builtins.\n"; | ||||
774 | 6332 291272 | 23626 978098 | map { print $trace_m4 "define([at_$_], defn([$_]))\n" } @m4_builtin; | ||||
775 | 6332 | 25625 | print $trace_m4 "\n"; | ||||
776 | |||||||
777 | 6332 | 10794 | print $trace_m4 "# Disable them.\n"; | ||||
778 | 6332 291272 | 11553 583733 | map { print $trace_m4 "at_undefine([$_])\n" } @m4_builtin; | ||||
779 | 6332 | 23544 | print $trace_m4 "\n"; | ||||
780 | |||||||
781 | |||||||
782 | # Neutralize traces: we don't want traces of cached requests (%REQUEST). | ||||||
783 | 6332 | 122178 | print $trace_m4 | ||||
784 | "## -------------------------------------- ##\n", | ||||||
785 | "## By default neutralize all the traces. ##\n", | ||||||
786 | "## -------------------------------------- ##\n", | ||||||
787 | "\n"; | ||||||
788 | 6332 | 41888 | print $trace_m4 "at_define([AT_$_], [at_dnl])\n" | ||||
789 | 6332 6332 | 8111 10912 | foreach (sort keys %{$req->macro}); | ||||
790 | 6332 | 25991 | print $trace_m4 "\n"; | ||||
791 | |||||||
792 | # Implement traces for current requests (%TRACE). | ||||||
793 | 6332 | 14447 | print $trace_m4 | ||||
794 | "## ------------------------- ##\n", | ||||||
795 | "## Trace processing macros. ##\n", | ||||||
796 | "## ------------------------- ##\n", | ||||||
797 | "\n"; | ||||||
798 | 6332 | 47799 | foreach (sort keys %trace) | ||||
799 | { | ||||||
800 | # Trace request can be embed \n. | ||||||
801 | 83104 | 325318 | (my $comment = "Trace $_:$trace{$_}") =~ s/^/\# /; | ||||
802 | 83104 | 154154 | print $trace_m4 "$comment\n"; | ||||
803 | 83104 | 153900 | print $trace_m4 "at_define([AT_$_],\n"; | ||||
804 | 83104 | 187190 | print $trace_m4 trace_format_to_m4 ($trace{$_}) . ")\n\n"; | ||||
805 | } | ||||||
806 | 6332 | 16279 | print $trace_m4 "\n"; | ||||
807 | |||||||
808 | # Reenable output. | ||||||
809 | 6332 | 10340 | print $trace_m4 "at_divert(0)at_dnl\n"; | ||||
810 | |||||||
811 | # Transform the traces from m4 into an m4 input file. | ||||||
812 | # Typically, transform: | ||||||
813 | # | ||||||
814 | # | m4trace:configure.ac:3: -1- AC_SUBST([exec_prefix], [NONE]) | ||||||
815 | # | ||||||
816 | # into | ||||||
817 | # | ||||||
818 | # | AT_AC_SUBST([configure.ac], [3], [1], [AC_SUBST], [exec_prefix], [NONE]) | ||||||
819 | # | ||||||
820 | # Pay attention that the file name might include colons, if under DOS | ||||||
821 | # for instance, so we don't use `[^:]+'. | ||||||
822 | 6332 | 30181 | my $traces = new Autom4te::XFile ("< " . open_quote ($tcache . $req->id)); | ||||
823 | 6332 | 28413 | while ($_ = $traces->getline) | ||||
824 | { | ||||||
825 | # Trace with arguments, as the example above. We don't try | ||||||
826 | # to match the trailing parenthesis as it might be on a | ||||||
827 | # separate line. | ||||||
828 | 3158010 | 14876850 | s{^m4trace:(.+):(\d+): -(\d+)- ([^(]+)\((.*)$} | ||||
829 | {AT_$4([$1], [$2], [$3], [$4], $5}; | ||||||
830 | # Traces without arguments, always on a single line. | ||||||
831 | 3158010 | 3189757 | s{^m4trace:(.+):(\d+): -(\d+)- ([^)]*)\n$} | ||||
832 | {AT_$4([$1], [$2], [$3], [$4])\n}; | ||||||
833 | 3158010 | 10604322 | print $trace_m4 "$_"; | ||||
834 | } | ||||||
835 | 6332 | 22217 | $trace_m4->close; | ||||
836 | |||||||
837 | 6332 | 515325 | my $in = new Autom4te::XFile ("$m4 " . shell_quote ("$tmp/traces.m4") . " |"); | ||||
838 | 6332 | 113057 | my $out = new Autom4te::XFile ("> " . open_quote ($output)); | ||||
839 | |||||||
840 | # This is dubious: should we really transform the quadrigraphs in | ||||||
841 | # traces? It might break balanced [ ] etc. in the output. The | ||||||
842 | # consensus seeems to be that traces are more useful this way. | ||||||
843 | 6332 | 42810 | while ($_ = $in->getline) | ||||
844 | { | ||||||
845 | # It makes no sense to try to transform __oline__. | ||||||
846 | 254169 | 309676 | s/\@<:\@/[/g; | ||||
847 | 254169 | 256463 | s/\@:>\@/]/g; | ||||
848 | 254169 | 253852 | s/\@\{:\@/(/g; | ||||
849 | 254169 | 250047 | s/\@:\}\@/)/g; | ||||
850 | 254169 | 248721 | s/\@S\|\@/\$/g; | ||||
851 | 254169 | 250465 | s/\@%:\@/#/g; | ||||
852 | 254169 | 251207 | s/\@&t\@//g; | ||||
853 | 254169 | 2290389 | print $out $_; | ||||
854 | } | ||||||
855 | } | ||||||
856 | |||||||
857 | |||||||
858 | # $BOOL | ||||||
859 | # up_to_date ($REQ) | ||||||
860 | # ----------------- | ||||||
861 | # Are the cache files of $REQ up to date? | ||||||
862 | # $REQ is `valid' if it corresponds to the request and exists, which | ||||||
863 | # does not mean it is up to date. It is up to date if, in addition, | ||||||
864 | # its files are younger than its dependencies. | ||||||
865 | sub up_to_date ($) | ||||||
866 | { | ||||||
867 | 2743 | 9734 | my ($req) = @_; | ||||
868 | |||||||
869 | 2743 | 9290 | return 0 | ||||
870 | if ! $req->valid; | ||||||
871 | |||||||
872 | 851 | 4007 | my $tfile = $tcache . $req->id; | ||||
873 | 851 | 2464 | my $ofile = $ocache . $req->id; | ||||
874 | |||||||
875 | # We can't answer properly if the traces are not computed since we | ||||||
876 | # need to know what other files were included. Actually, if any of | ||||||
877 | # the cache files is missing, we are not up to date. | ||||||
878 | 851 | 36986 | return 0 | ||||
879 | if ! -f $tfile || ! -f $ofile; | ||||||
880 | |||||||
881 | # The youngest of the cache files must be older than the oldest of | ||||||
882 | # the dependencies. | ||||||
883 | 851 | 3210 | my $tmtime = mtime ($tfile); | ||||
884 | 851 | 3691 | my $omtime = mtime ($ofile); | ||||
885 | 851 | 3562 | my ($file, $mtime) = ($tmtime < $omtime | ||||
886 | ? ($ofile, $omtime) : ($tfile, $tmtime)); | ||||||
887 | |||||||
888 | # We depend at least upon the arguments. | ||||||
889 | 851 | 2448 | my @dep = @ARGV; | ||||
890 | |||||||
891 | # stdin is always out of date. | ||||||
892 | 851 3752 | 1648 20209 | if (grep { $_ eq '-' } @dep) | ||||
893 | 0 | 0 | { return 0 } | ||||
894 | |||||||
895 | # Files may include others. We can use traces since we just checked | ||||||
896 | # if they are available. | ||||||
897 | 851 | 7883 | handle_traces ($req, "$tmp/dependencies", | ||||
898 | ('include' => '$1', | ||||||
899 | 'm4_include' => '$1')); | ||||||
900 | 851 | 6579 | my $deps = new Autom4te::XFile ("< " . open_quote ("$tmp/dependencies")); | ||||
901 | 851 | 4463 | while ($_ = $deps->getline) | ||||
902 | { | ||||||
903 | 178 | 374 | chomp; | ||||
904 | 178 | 864 | my $file = find_file ("$_?", @include); | ||||
905 | # If a file which used to be included is no longer there, then | ||||||
906 | # don't say it's missing (it might no longer be included). But | ||||||
907 | # of course, that causes the output to be outdated (as if the | ||||||
908 | # time stamp of that missing file was newer). | ||||||
909 | 178 | 6027 | return 0 | ||||
910 | if ! $file; | ||||||
911 | 177 | 668 | push @dep, $file; | ||||
912 | } | ||||||
913 | |||||||
914 | # If $FILE is younger than one of its dependencies, it is outdated. | ||||||
915 | 850 | 8825 | return up_to_date_p ($file, @dep); | ||||
916 | } | ||||||
917 | |||||||
918 | |||||||
919 | ## ---------- ## | ||||||
920 | ## Freezing. ## | ||||||
921 | ## ---------- ## | ||||||
922 | |||||||
923 | # freeze ($OUTPUT) | ||||||
924 | # ---------------- | ||||||
925 | sub freeze ($) | ||||||
926 | { | ||||||
927 | 0 | my ($output) = @_; | |||||
928 | |||||||
929 | # When processing the file with diversion disabled, there must be no | ||||||
930 | # output but comments and empty lines. | ||||||
931 | 0 | my $result = xqx ("$m4" | |||||
932 | . ' --fatal-warning' | ||||||
933 | 0 | . join (' --include=', '', map { shell_quote ($_) } @include) | |||||
934 | . ' --define=divert' | ||||||
935 | . " " . files_to_options (@ARGV) | ||||||
936 | . ' </dev/null'); | ||||||
937 | 0 | $result =~ s/#.*\n//g; | |||||
938 | 0 | $result =~ s/^\n//mg; | |||||
939 | |||||||
940 | 0 | fatal "freezing produced output:\n$result" | |||||
941 | if $result; | ||||||
942 | |||||||
943 | # If freezing produces output, something went wrong: a bad `divert', | ||||||
944 | # or an improper paren etc. | ||||||
945 | 0 | xsystem ("$m4" | |||||
946 | . ' --fatal-warning' | ||||||
947 | 0 | . join (' --include=', '', map { shell_quote ($_) } @include) | |||||
948 | . " --freeze-state=" . shell_quote ($output) | ||||||
949 | . " " . files_to_options (@ARGV) | ||||||
950 | . ' </dev/null'); | ||||||
951 | } | ||||||
952 | |||||||
953 | ## -------------- ## | ||||||
954 | ## Main program. ## | ||||||
955 | ## -------------- ## | ||||||
956 | |||||||
957 | 2758 | 33576 | mktmpdir ('am4t'); | ||||
958 | 2758 | 106912 | load_configuration ($ENV{'AUTOM4TE_CFG'} || "$pkgdatadir/autom4te.cfg"); | ||||
959 | 2758 | 80249 | load_configuration ("$ENV{'HOME'}/.autom4te.cfg") | ||||
960 | if exists $ENV{'HOME'} && -f "$ENV{'HOME'}/.autom4te.cfg"; | ||||||
961 | 2758 | 23919 | load_configuration (".autom4te.cfg") | ||||
962 | if -f ".autom4te.cfg"; | ||||||
963 | 2758 | 13758 | parse_args; | ||||
964 | |||||||
965 | # Freezing does not involve the cache. | ||||||
966 | 2758 | 8717 | if ($freeze) | ||||
967 | { | ||||||
968 | 0 | 0 | freeze ($output); | ||||
969 | 0 | 0 | exit $exit_code; | ||||
970 | } | ||||||
971 | |||||||
972 | # We need our cache directory. Don't fail with parallel creation. | ||||||
973 | 2758 | 19401 | if (! -d "$cache") | ||||
974 | { | ||||||
975 | 950 | 135983 | mkdir "$cache", 0755 | ||||
976 | or -d "$cache" | ||||||
977 | or fatal "cannot create $cache: $!"; | ||||||
978 | } | ||||||
979 | |||||||
980 | # Open the index for update, and lock it. autom4te handles several | ||||||
981 | # files, but the index is the first and last file to be updated, so | ||||||
982 | # locking it is sufficient. | ||||||
983 | 2758 | 22520 | $icache_file = new Autom4te::XFile $icache, O_RDWR|O_CREAT; | ||||
984 | 2758 | 26860 | $icache_file->lock (LOCK_EX) | ||||
985 | if ($flock_implemented eq "yes"); | ||||||
986 | |||||||
987 | # Read the cache index if available and older than autom4te itself. | ||||||
988 | # If autom4te is younger, then some structures such as C4che might | ||||||
989 | # have changed, which would corrupt its processing. | ||||||
990 | 2758 | 36578 | Autom4te::C4che->load ($icache_file) | ||||
991 | if -f $icache && mtime ($icache) > mtime ($0); | ||||||
992 | |||||||
993 | # Add the new trace requests. | ||||||
994 | 2758 | 57896 | my $req = Autom4te::C4che->request ('input' => \@ARGV, | ||||
995 | 'path' => \@include, | ||||||
996 | 'macro' => [keys %trace, @preselect]); | ||||||
997 | |||||||
998 | # If $REQ's cache files are not up to date, or simply if the user | ||||||
999 | # discarded them (-f), declare it invalid. | ||||||
1000 | 2758 | 46776 | $req->valid (0) | ||||
1001 | if $force || ! up_to_date ($req); | ||||||
1002 | |||||||
1003 | # We now know whether we can trust the Request object. Say it. | ||||||
1004 | 2758 | 23257 | verb "the trace request object is:\n" . $req->marshall; | ||||
1005 | |||||||
1006 | # We need to run M4 if (i) the user wants it (--force), (ii) $REQ is | ||||||
1007 | # invalid. | ||||||
1008 | 2758 2025 | 27398 5379 | handle_m4 ($req, keys %{$req->macro}) | ||||
1009 | if $force || ! $req->valid; | ||||||
1010 | |||||||
1011 | # Issue the warnings each time autom4te was run. | ||||||
1012 | 2742 | 189874 | my $separator = "\n" . ('-' x 25) . " END OF WARNING " . ('-' x 25) . "\n\n"; | ||||
1013 | 2742 | 29066 | handle_traces ($req, "$tmp/warnings", | ||||
1014 | ('_m4_warn' => "\$1::\$f:\$l::\$2::\$3$separator")); | ||||||
1015 | # Swallow excessive newlines. | ||||||
1016 | 2742 | 100295 | for (split (/\n*$separator\n*/o, contents ("$tmp/warnings"))) | ||||
1017 | { | ||||||
1018 | # The message looks like: | ||||||
1019 | # | syntax::input.as:5::ouch | ||||||
1020 | # | ::input.as:4: baz is expanded from... | ||||||
1021 | # | input.as:2: bar is expanded from... | ||||||
1022 | # | input.as:3: foo is expanded from... | ||||||
1023 | # | input.as:5: the top level | ||||||
1024 | # In particular, m4_warn guarantees that either $stackdump is empty, or | ||||||
1025 | # it consists of lines where only the last line ends in "top level". | ||||||
1026 | 487 | 3031 | my ($cat, $loc, $msg, $stacktrace) = split ('::', $_, 4); | ||||
1027 | 487 | 3091 | msg $cat, $loc, "warning: $msg", | ||||
1028 | partial => ($stacktrace =~ /top level$/) + 0; | ||||||
1029 | 487 | 2526 | for (split /\n/, $stacktrace) | ||||
1030 | { | ||||||
1031 | 1106 | 3208 | my ($loc, $trace) = split (': ', $_, 2); | ||||
1032 | 1106 | 3995 | msg $cat, $loc, $trace, partial => ($trace !~ /top level$/) + 0; | ||||
1033 | } | ||||||
1034 | } | ||||||
1035 | |||||||
1036 | # Now output... | ||||||
1037 | 2742 | 21201 | if (%trace) | ||||
1038 | { | ||||||
1039 | # Always produce traces, since even if the output is young enough, | ||||||
1040 | # there is no guarantee that the traces use the same *format* | ||||||
1041 | # (e.g., `-t FOO:foo' and `-t FOO:bar' are both using the same M4 | ||||||
1042 | # traces, hence the M4 traces cache is usable, but its formatting | ||||||
1043 | # will yield different results). | ||||||
1044 | 2159 | 78185 | handle_traces ($req, $output, %trace); | ||||
1045 | } | ||||||
1046 | else | ||||||
1047 | { | ||||||
1048 | # Actual M4 expansion, if the user wants it, or if $output is old | ||||||
1049 | # (STDOUT is pretty old). | ||||||
1050 | 583 | 7646 | handle_output ($req, $output) | ||||
1051 | if $force || mtime ($output) < mtime ($ocache . $req->id); | ||||||
1052 | } | ||||||
1053 | |||||||
1054 | # If we ran up to here, the cache is valid. | ||||||
1055 | 2742 | 43225 | $req->valid (1); | ||||
1056 | 2742 | 36672 | Autom4te::C4che->save ($icache_file); | ||||
1057 | |||||||
1058 | 2742 | 6243 | exit $exit_code; | ||||
1059 | |||||||
1060 | ### Setup "GNU" style for perl-mode and cperl-mode. | ||||||
1061 | ## Local Variables: | ||||||
1062 | ## perl-indent-level: 2 | ||||||
1063 | ## perl-continued-statement-offset: 2 | ||||||
1064 | ## perl-continued-brace-offset: 0 | ||||||
1065 | ## perl-brace-offset: 0 | ||||||
1066 | ## perl-brace-imaginary-offset: 0 | ||||||
1067 | ## perl-label-offset: -2 | ||||||
1068 | ## cperl-indent-level: 2 | ||||||
1069 | ## cperl-brace-offset: 0 | ||||||
1070 | ## cperl-continued-brace-offset: 0 | ||||||
1071 | ## cperl-label-offset: -2 | ||||||
1072 | ## cperl-extra-newline-before-brace: t | ||||||
1073 | ## cperl-merge-trailing-else: nil | ||||||
1074 | ## cperl-continued-statement-offset: 2 | ||||||
1075 | ## End: |