xf.li | 8402749 | 2024-04-09 00:17:51 -0700 | [diff] [blame^] | 1 | #! /usr/bin/perl |
| 2 | # -*- perl -*- |
| 3 | # Generated from bin/autom4te.in; do not edit by hand. |
| 4 | |
| 5 | 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-2003, 2005-2017, 2020-2021 Free Software |
| 10 | # 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 <https://www.gnu.org/licenses/>. |
| 24 | |
| 25 | use 5.006; |
| 26 | use strict; |
| 27 | use warnings FATAL => 'all'; |
| 28 | |
| 29 | BEGIN |
| 30 | { |
| 31 | my $pkgdatadir = $ENV{'autom4te_perllibdir'} || '/home/zhouguopo/code2/0616/ap/project/zx297520v3/prj_mdl/build/../../../../build/depends/install/share/autoconf'; |
| 32 | unshift @INC, $pkgdatadir; |
| 33 | |
| 34 | # Override SHELL. On DJGPP SHELL may not be set to a shell |
| 35 | # that can handle redirection and quote arguments correctly, |
| 36 | # e.g.: COMMAND.COM. For DJGPP always use the shell that configure |
| 37 | # has detected. |
| 38 | $ENV{'SHELL'} = '/bin/bash' if ($^O eq 'dos'); |
| 39 | } |
| 40 | |
| 41 | use File::Basename; |
| 42 | |
| 43 | use Autom4te::C4che; |
| 44 | use Autom4te::ChannelDefs; |
| 45 | use Autom4te::Channels; |
| 46 | use Autom4te::FileUtils; |
| 47 | use Autom4te::General; |
| 48 | use Autom4te::XFile; |
| 49 | |
| 50 | # Data directory. |
| 51 | my $pkgdatadir = $ENV{'AC_MACRODIR'} || '/home/zhouguopo/code2/0616/ap/project/zx297520v3/prj_mdl/build/../../../../build/depends/install/share/autoconf'; |
| 52 | |
| 53 | # $LANGUAGE{LANGUAGE} -- Automatic options for LANGUAGE. |
| 54 | my %language; |
| 55 | |
| 56 | my $output = '-'; |
| 57 | |
| 58 | # Mode of the output file except for traces. |
| 59 | my $mode = "0666"; |
| 60 | |
| 61 | # If melt, don't use frozen files. |
| 62 | my $melt = 0; |
| 63 | |
| 64 | # Names of the cache directory, cache directory index, trace cache |
| 65 | # prefix, and output cache prefix. And the IO object for the index. |
| 66 | my $cache; |
| 67 | my $icache; |
| 68 | my $tcache; |
| 69 | my $ocache; |
| 70 | my $icache_file; |
| 71 | |
| 72 | my $flock_implemented = 'yes'; |
| 73 | |
| 74 | # The macros to trace mapped to their format, as specified by the |
| 75 | # user. |
| 76 | my %trace; |
| 77 | |
| 78 | # The macros the user will want to trace in the future. |
| 79 | # We need 'include' to get the included file, 'm4_pattern_forbid' and |
| 80 | # 'm4_pattern_allow' to check the output. |
| 81 | # |
| 82 | # FIXME: What about 'sinclude'? |
| 83 | my @preselect = ('include', |
| 84 | 'm4_pattern_allow', 'm4_pattern_forbid', |
| 85 | '_m4_warn'); |
| 86 | |
| 87 | # M4 include path. |
| 88 | my @include; |
| 89 | |
| 90 | # Do we freeze? |
| 91 | my $freeze = 0; |
| 92 | |
| 93 | # $M4. |
| 94 | my $m4 = $ENV{"M4"} || '/usr/bin/m4'; |
| 95 | # Some non-GNU m4's don't reject the --help option, so give them /dev/null. |
| 96 | fatal "need GNU m4 1.4 or later: $m4" |
| 97 | if system "$m4 --help </dev/null 2>&1 | grep reload-state >/dev/null"; |
| 98 | |
| 99 | # Set some high recursion limit as the default limit, 250, has already |
| 100 | # been hit with AC_OUTPUT. Don't override the user's choice. |
| 101 | $m4 .= ' --nesting-limit=1024' |
| 102 | if " $m4 " !~ / (--nesting-limit(=[0-9]+)?|-L[0-9]*) /; |
| 103 | |
| 104 | |
| 105 | # @M4_BUILTIN -- M4 builtins and a useful comment. |
| 106 | my @m4_builtin = `echo dumpdef | $m4 2>&1 >/dev/null`; |
| 107 | map { s/:.*//;s/\W// } @m4_builtin; |
| 108 | |
| 109 | |
| 110 | # %M4_BUILTIN_ALTERNATE_NAME |
| 111 | # -------------------------- |
| 112 | # The builtins are renamed, e.g., 'define' is renamed 'm4_define'. |
| 113 | # So map 'define' to 'm4_define' and conversely. |
| 114 | # Some macros don't follow this scheme: be sure to properly map to their |
| 115 | # alternate name too. |
| 116 | # |
| 117 | # FIXME: Trace status of renamed builtins was fixed in M4 1.4.5, which |
| 118 | # we now depend on; do we still need to do this mapping? |
| 119 | # |
| 120 | # So we will merge them, i.e., tracing 'BUILTIN' or tracing |
| 121 | # 'm4_BUILTIN' will be the same: tracing both, but honoring the |
| 122 | # *last* trace specification. |
| 123 | # |
| 124 | # FIXME: This is not enough: in the output '$0' will be 'BUILTIN' |
| 125 | # sometimes and 'm4_BUILTIN' at others. We should return a unique name, |
| 126 | # the one specified by the user. |
| 127 | # |
| 128 | # FIXME: To be absolutely rigorous, I would say that given that we |
| 129 | # _redefine_ divert (instead of _copying_ it), divert and the like |
| 130 | # should not be part of this list. |
| 131 | my %m4_builtin_alternate_name; |
| 132 | @m4_builtin_alternate_name{"$_", "m4_$_"} = ("m4_$_", "$_") |
| 133 | foreach (grep { !/m4wrap|m4exit|dnl|ifelse|__.*__/ } @m4_builtin); |
| 134 | @m4_builtin_alternate_name{"ifelse", "m4_if"} = ("m4_if", "ifelse"); |
| 135 | @m4_builtin_alternate_name{"m4exit", "m4_exit"} = ("m4_exit", "m4exit"); |
| 136 | @m4_builtin_alternate_name{"m4wrap", "m4_wrap"} = ("m4_wrap", "m4wrap"); |
| 137 | |
| 138 | |
| 139 | # $HELP |
| 140 | # ----- |
| 141 | $help = "Usage: $0 [OPTION]... [FILES] |
| 142 | |
| 143 | Run GNU M4 on the FILES, avoiding useless runs. Output the traces if tracing, |
| 144 | the frozen file if freezing, otherwise the expansion of the FILES. |
| 145 | |
| 146 | If some of the FILES are named 'FILE.m4f' they are considered to be M4 |
| 147 | frozen files of all the previous files (which are therefore not loaded). |
| 148 | If 'FILE.m4f' is not found, then 'FILE.m4' will be used, together with |
| 149 | all the previous files. |
| 150 | |
| 151 | Some files may be optional, i.e., will only be processed if found in the |
| 152 | include path, but then must end in '.m4?'; the question mark is not part |
| 153 | of the actual file name. |
| 154 | |
| 155 | Operation modes: |
| 156 | -h, --help print this help, then exit |
| 157 | -V, --version print version number, then exit |
| 158 | -v, --verbose verbosely report processing |
| 159 | -d, --debug don't remove temporary files |
| 160 | -o, --output=FILE save output in FILE (defaults to '-', stdout) |
| 161 | -f, --force don't rely on cached values |
| 162 | -W, --warnings=CATEGORY report the warnings falling in CATEGORY |
| 163 | -l, --language=LANG specify the set of M4 macros to use |
| 164 | -C, --cache=DIRECTORY preserve results for future runs in DIRECTORY |
| 165 | --no-cache disable the cache |
| 166 | -m, --mode=OCTAL change the non trace output file mode (0666) |
| 167 | -M, --melt don't use M4 frozen files |
| 168 | |
| 169 | Languages include: |
| 170 | 'Autoconf' create Autoconf configure scripts |
| 171 | 'Autotest' create Autotest test suites |
| 172 | 'M4sh' create M4sh shell scripts |
| 173 | 'M4sugar' create M4sugar output |
| 174 | |
| 175 | " . Autom4te::ChannelDefs::usage . " |
| 176 | |
| 177 | The environment variables 'M4' and 'WARNINGS' are honored. |
| 178 | |
| 179 | Library directories: |
| 180 | -B, --prepend-include=DIR prepend directory DIR to search path |
| 181 | -I, --include=DIR append directory DIR to search path |
| 182 | |
| 183 | Tracing: |
| 184 | -t, --trace=MACRO[:FORMAT] report the MACRO invocations |
| 185 | -p, --preselect=MACRO prepare to trace MACRO in a future run |
| 186 | |
| 187 | Freezing: |
| 188 | -F, --freeze produce an M4 frozen state file for FILES |
| 189 | |
| 190 | FORMAT defaults to '\$f:\$l:\$n:\$%', and can use the following escapes: |
| 191 | \$\$ literal \$ |
| 192 | \$f file where macro was called |
| 193 | \$l line where macro was called |
| 194 | \$d nesting depth of macro call |
| 195 | \$n name of the macro |
| 196 | \$NUM argument NUM, unquoted and with newlines |
| 197 | \$SEP\@ all arguments, with newlines, quoted, and separated by SEP |
| 198 | \$SEP* all arguments, with newlines, unquoted, and separated by SEP |
| 199 | \$SEP% all arguments, without newlines, unquoted, and separated by SEP |
| 200 | SEP can be empty for the default (comma for \@ and *, colon for %), |
| 201 | a single character for that character, or {STRING} to use a string. |
| 202 | |
| 203 | Report bugs to <bug-autoconf\@gnu.org>. |
| 204 | GNU Autoconf home page: <https://www.gnu.org/software/autoconf/>. |
| 205 | General help using GNU software: <https://www.gnu.org/gethelp/>. |
| 206 | "; |
| 207 | |
| 208 | # $VERSION |
| 209 | # -------- |
| 210 | $version = "autom4te (GNU Autoconf) 2.71 |
| 211 | Copyright (C) 2021 Free Software Foundation, Inc. |
| 212 | License GPLv3+/Autoconf: GNU GPL version 3 or later |
| 213 | <https://gnu.org/licenses/gpl.html>, <https://gnu.org/licenses/exceptions.html> |
| 214 | This is free software: you are free to change and redistribute it. |
| 215 | There is NO WARRANTY, to the extent permitted by law. |
| 216 | |
| 217 | Written by Akim Demaille. |
| 218 | "; |
| 219 | |
| 220 | |
| 221 | ## ---------- ## |
| 222 | ## Routines. ## |
| 223 | ## ---------- ## |
| 224 | |
| 225 | |
| 226 | # $OPTION |
| 227 | # files_to_options (@FILE) |
| 228 | # ------------------------ |
| 229 | # Transform Autom4te conventions (e.g., using foo.m4f to designate a frozen |
| 230 | # file) into a suitable command line for M4 (e.g., using --reload-state). |
| 231 | # parse_args guarantees that we will see at most one frozen file, and that |
| 232 | # if a frozen file is present, it is the first argument. |
| 233 | sub files_to_options (@) |
| 234 | { |
| 235 | my (@file) = @_; |
| 236 | my @res; |
| 237 | foreach my $file (@file) |
| 238 | { |
| 239 | my $arg = shell_quote ($file); |
| 240 | if ($file =~ /\.m4f$/) |
| 241 | { |
| 242 | $arg = "--reload-state=$arg"; |
| 243 | # If the user downgraded M4 from 1.6 to 1.4.x after freezing |
| 244 | # the file, then we ensure the frozen __m4_version__ will |
| 245 | # not cause m4_init to make the wrong decision about the |
| 246 | # current M4 version. |
| 247 | $arg .= " --undefine=__m4_version__" |
| 248 | unless grep {/__m4_version__/} @m4_builtin; |
| 249 | } |
| 250 | push @res, $arg; |
| 251 | } |
| 252 | return join ' ', @res; |
| 253 | } |
| 254 | |
| 255 | |
| 256 | # load_configuration ($FILE) |
| 257 | # -------------------------- |
| 258 | # Load the configuration $FILE. |
| 259 | sub load_configuration ($) |
| 260 | { |
| 261 | my ($file) = @_; |
| 262 | use Text::ParseWords; |
| 263 | |
| 264 | my $cfg = new Autom4te::XFile ($file, "<"); |
| 265 | my $lang; |
| 266 | while ($_ = $cfg->getline) |
| 267 | { |
| 268 | chomp; |
| 269 | # Comments. |
| 270 | next |
| 271 | if /^\s*(\#.*)?$/; |
| 272 | |
| 273 | my @words = shellwords ($_); |
| 274 | my $type = shift @words; |
| 275 | if ($type eq 'begin-language:') |
| 276 | { |
| 277 | fatal "$file:$.: end-language missing for: $lang" |
| 278 | if defined $lang; |
| 279 | $lang = lc $words[0]; |
| 280 | } |
| 281 | elsif ($type eq 'end-language:') |
| 282 | { |
| 283 | error "$file:$.: end-language mismatch: $lang" |
| 284 | if $lang ne lc $words[0]; |
| 285 | $lang = undef; |
| 286 | } |
| 287 | elsif ($type eq 'args:') |
| 288 | { |
| 289 | fatal "$file:$.: no current language" |
| 290 | unless defined $lang; |
| 291 | push @{$language{$lang}}, @words; |
| 292 | } |
| 293 | else |
| 294 | { |
| 295 | error "$file:$.: unknown directive: $type"; |
| 296 | } |
| 297 | } |
| 298 | } |
| 299 | |
| 300 | |
| 301 | # parse_args () |
| 302 | # ------------- |
| 303 | # Process any command line arguments. |
| 304 | sub parse_args () |
| 305 | { |
| 306 | # We want to look for the early options, which should not be found |
| 307 | # in the configuration file. Prepend to the user arguments. |
| 308 | # Perform this repeatedly so that we can use --language in language |
| 309 | # definitions. Beware that there can be several --language |
| 310 | # invocations. |
| 311 | my @language; |
| 312 | do { |
| 313 | @language = (); |
| 314 | use Getopt::Long; |
| 315 | Getopt::Long::Configure ("pass_through", "permute"); |
| 316 | GetOptions ("l|language=s" => \@language); |
| 317 | |
| 318 | foreach (@language) |
| 319 | { |
| 320 | error "unknown language: $_" |
| 321 | unless exists $language{lc $_}; |
| 322 | unshift @ARGV, @{$language{lc $_}}; |
| 323 | } |
| 324 | } while @language; |
| 325 | |
| 326 | # --debug is useless: it is parsed below. |
| 327 | if (exists $ENV{'AUTOM4TE_DEBUG'}) |
| 328 | { |
| 329 | print STDERR "$me: concrete arguments:\n"; |
| 330 | foreach my $arg (@ARGV) |
| 331 | { |
| 332 | print STDERR "| $arg\n"; |
| 333 | } |
| 334 | } |
| 335 | |
| 336 | # Process the arguments for real this time. |
| 337 | my @trace; |
| 338 | my @prepend_include; |
| 339 | my @warnings; |
| 340 | |
| 341 | getopt |
| 342 | ( |
| 343 | # Operation modes: |
| 344 | "o|output=s" => \$output, |
| 345 | "W|warnings=s" => \@warnings, |
| 346 | "m|mode=s" => \$mode, |
| 347 | "M|melt" => \$melt, |
| 348 | |
| 349 | # Library directories: |
| 350 | "B|prepend-include=s" => \@prepend_include, |
| 351 | "I|include=s" => \@include, |
| 352 | |
| 353 | # Tracing: |
| 354 | # Using a hash for traces is seducing. Unfortunately, upon '-t FOO', |
| 355 | # instead of mapping 'FOO' to undef, Getopt maps it to '1', preventing |
| 356 | # us from distinguishing '-t FOO' from '-t FOO=1'. So let's do it |
| 357 | # by hand. |
| 358 | "t|trace=s" => \@trace, |
| 359 | "p|preselect=s" => \@preselect, |
| 360 | |
| 361 | # Freezing. |
| 362 | "F|freeze" => \$freeze, |
| 363 | |
| 364 | # Caching. |
| 365 | "C|cache=s" => \$cache, |
| 366 | "no-cache" => sub { $cache = undef; }, |
| 367 | ); |
| 368 | |
| 369 | parse_WARNINGS; |
| 370 | parse_warnings @warnings; |
| 371 | |
| 372 | fatal "too few arguments |
| 373 | Try '$me --help' for more information." |
| 374 | unless @ARGV; |
| 375 | |
| 376 | # Freezing: |
| 377 | # We cannot trace at the same time (well, we can, but it sounds insane). |
| 378 | # And it implies melting: there is risk not to update properly using |
| 379 | # old frozen files, and worse yet: we could load a frozen file and |
| 380 | # refreeze it! A sort of caching :) |
| 381 | fatal "cannot freeze and trace" |
| 382 | if $freeze && @trace; |
| 383 | $melt = 1 |
| 384 | if $freeze; |
| 385 | |
| 386 | # Names of the cache directory, cache directory index, trace cache |
| 387 | # prefix, and output cache prefix. If the cache is not to be |
| 388 | # preserved, default to a temporary directory (automatically removed |
| 389 | # on exit). |
| 390 | $cache = $tmp |
| 391 | unless $cache; |
| 392 | $icache = "$cache/requests"; |
| 393 | $tcache = "$cache/traces."; |
| 394 | $ocache = "$cache/output."; |
| 395 | |
| 396 | # Normalize the includes: the first occurrence is enough, several is |
| 397 | # a pain since it introduces a useless difference in the path which |
| 398 | # invalidates the cache. And strip '.' which is implicit and always |
| 399 | # first. |
| 400 | @include = grep { !/^\.$/ } uniq (reverse(@prepend_include), @include); |
| 401 | |
| 402 | # Convert @trace to %trace, and work around the M4 builtins tracing |
| 403 | # problem. |
| 404 | # The default format is '$f:$l:$n:$%'. |
| 405 | foreach (@trace) |
| 406 | { |
| 407 | /^([^:]+)(?::(.*))?$/ms; |
| 408 | $trace{$1} = defined $2 ? $2 : '$f:$l:$n:$%'; |
| 409 | $trace{$m4_builtin_alternate_name{$1}} = $trace{$1} |
| 410 | if exists $m4_builtin_alternate_name{$1}; |
| 411 | } |
| 412 | |
| 413 | # Work around the M4 builtins tracing problem for @PRESELECT. |
| 414 | # FIXME: Is this still needed, now that we rely on M4 1.4.5? |
| 415 | push (@preselect, |
| 416 | map { $m4_builtin_alternate_name{$_} } |
| 417 | grep { exists $m4_builtin_alternate_name{$_} } @preselect); |
| 418 | |
| 419 | # If we find frozen files, then all the files before it are |
| 420 | # discarded: the frozen file is supposed to include them all. |
| 421 | # |
| 422 | # We don't want to depend upon m4's --include to find the top level |
| 423 | # files, so we use 'find_file' here. Try to get a canonical name, |
| 424 | # as it's part of the key for caching. And some files are optional |
| 425 | # (also handled by 'find_file'). |
| 426 | my @argv; |
| 427 | foreach (@ARGV) |
| 428 | { |
| 429 | if ($_ eq '-') |
| 430 | { |
| 431 | push @argv, $_; |
| 432 | } |
| 433 | elsif (/\.m4f$/) |
| 434 | { |
| 435 | # Frozen files are optional => pass a '?' to 'find_file'. |
| 436 | my $file = find_file ("$_?", @include); |
| 437 | if (!$melt && $file) |
| 438 | { |
| 439 | @argv = ($file); |
| 440 | } |
| 441 | else |
| 442 | { |
| 443 | s/\.m4f$/.m4/; |
| 444 | push @argv, find_file ($_, @include); |
| 445 | } |
| 446 | } |
| 447 | else |
| 448 | { |
| 449 | my $file = find_file ($_, @include); |
| 450 | push @argv, $file |
| 451 | if $file; |
| 452 | } |
| 453 | } |
| 454 | @ARGV = @argv; |
| 455 | } |
| 456 | |
| 457 | |
| 458 | # handle_m4 ($REQ, @MACRO) |
| 459 | # ------------------------ |
| 460 | # Run m4 on the input files, and save the traces on the @MACRO. |
| 461 | sub handle_m4 ($@) |
| 462 | { |
| 463 | my ($req, @macro) = @_; |
| 464 | |
| 465 | # GNU m4 appends when using --debugfile/--error-output. |
| 466 | unlink ($tcache . $req->id . "t"); |
| 467 | |
| 468 | # Run m4. |
| 469 | # |
| 470 | # We don't output directly to the cache files, to avoid problems |
| 471 | # when we are interrupted (that leaves corrupted files). |
| 472 | xsystem ("$m4 --gnu" |
| 473 | . join (' --include=', '', map { shell_quote ($_) } @include) |
| 474 | . ' --debug=aflq' |
| 475 | . (!exists $ENV{'AUTOM4TE_NO_FATAL'} ? ' --fatal-warning' : '') |
| 476 | . " --debugfile=" . shell_quote ("$tcache" . $req->id . "t") |
| 477 | . join (' --trace=', '', map { shell_quote ($_) } sort @macro) |
| 478 | . " " . files_to_options (@ARGV) |
| 479 | . " > " . shell_quote ("$ocache" . $req->id . "t")); |
| 480 | |
| 481 | # Everything went ok: preserve the outputs. |
| 482 | foreach my $file (map { $_ . $req->id } ($tcache, $ocache)) |
| 483 | { |
| 484 | use File::Copy; |
| 485 | move ("${file}t", "$file") |
| 486 | or fatal "cannot rename ${file}t as $file: $!"; |
| 487 | } |
| 488 | } |
| 489 | |
| 490 | |
| 491 | # warn_forbidden ($WHERE, $WORD, %FORBIDDEN) |
| 492 | # ------------------------------------------ |
| 493 | # $WORD is forbidden. Warn with a dedicated error message if in |
| 494 | # %FORBIDDEN, otherwise a simple 'error: possibly undefined macro' |
| 495 | # will do. |
| 496 | my $first_warn_forbidden = 1; |
| 497 | sub warn_forbidden ($$%) |
| 498 | { |
| 499 | my ($where, $word, %forbidden) = @_; |
| 500 | my $message; |
| 501 | |
| 502 | for my $re (sort keys %forbidden) |
| 503 | { |
| 504 | if ($word =~ $re) |
| 505 | { |
| 506 | $message = $forbidden{$re}; |
| 507 | last; |
| 508 | } |
| 509 | } |
| 510 | $message ||= "possibly undefined macro: $word"; |
| 511 | warn "$where: error: $message\n"; |
| 512 | if ($first_warn_forbidden) |
| 513 | { |
| 514 | warn <<EOF; |
| 515 | If this token and others are legitimate, please use m4_pattern_allow. |
| 516 | See the Autoconf documentation. |
| 517 | EOF |
| 518 | $first_warn_forbidden = 0; |
| 519 | } |
| 520 | } |
| 521 | |
| 522 | |
| 523 | # handle_output ($REQ, $OUTPUT) |
| 524 | # ----------------------------- |
| 525 | # Run m4 on the input files, perform quadrigraphs substitution, check for |
| 526 | # forbidden tokens, and save into $OUTPUT. |
| 527 | sub handle_output ($$) |
| 528 | { |
| 529 | my ($req, $output) = @_; |
| 530 | |
| 531 | verb "creating $output"; |
| 532 | |
| 533 | # Load the forbidden/allowed patterns. |
| 534 | handle_traces ($req, "$tmp/patterns", |
| 535 | ('m4_pattern_forbid' => 'forbid:$1:$2', |
| 536 | 'm4_pattern_allow' => 'allow:$1')); |
| 537 | my @patterns = new Autom4te::XFile ("$tmp/patterns", "<")->getlines; |
| 538 | chomp @patterns; |
| 539 | my %forbidden = |
| 540 | map { /^forbid:([^:]+):.+$/ => /^forbid:[^:]+:(.+)$/ } @patterns; |
| 541 | my $forbidden = join ('|', map { /^forbid:([^:]+)/ } @patterns) || "^\$"; |
| 542 | my $allowed = join ('|', map { /^allow:([^:]+)/ } @patterns) || "^\$"; |
| 543 | |
| 544 | verb "forbidden tokens: $forbidden"; |
| 545 | verb "forbidden token : $_ => $forbidden{$_}" |
| 546 | foreach (sort keys %forbidden); |
| 547 | verb "allowed tokens: $allowed"; |
| 548 | |
| 549 | # Read the (cached) raw M4 output, produce the actual result. |
| 550 | # If we are writing to a regular file, replace it atomically. |
| 551 | my $scratchfile; |
| 552 | my $out; |
| 553 | if ($output eq '-') |
| 554 | { |
| 555 | # Don't just make $out be STDOUT, because then we would close STDOUT, |
| 556 | # which we already do in END. |
| 557 | $out = new Autom4te::XFile ('>&STDOUT'); |
| 558 | } |
| 559 | elsif (-e $output && ! -f $output) |
| 560 | { |
| 561 | $out = new Autom4te::XFile ($output, '>'); |
| 562 | } |
| 563 | else |
| 564 | { |
| 565 | my (undef, $outdir, undef) = fileparse ($output); |
| 566 | |
| 567 | use File::Temp qw (tempfile); |
| 568 | ($out, $scratchfile) = tempfile (UNLINK => 0, DIR => $outdir); |
| 569 | fatal "cannot create a file in $outdir: $!" |
| 570 | unless $out; |
| 571 | |
| 572 | # File::Temp doesn't give us access to 3-arg open(2), unfortunately. |
| 573 | chmod (oct ($mode) & ~(umask), $scratchfile) |
| 574 | or fatal "setting mode of " . $scratchfile . ": $!"; |
| 575 | } |
| 576 | |
| 577 | my $in = new Autom4te::XFile ($ocache . $req->id, "<"); |
| 578 | |
| 579 | my %prohibited; |
| 580 | my $res; |
| 581 | while ($_ = $in->getline) |
| 582 | { |
| 583 | s/\s+$//; |
| 584 | s/__oline__/$./g; |
| 585 | s/\@<:\@/[/g; |
| 586 | s/\@:>\@/]/g; |
| 587 | s/\@\{:\@/(/g; |
| 588 | s/\@:\}\@/)/g; |
| 589 | s/\@S\|\@/\$/g; |
| 590 | s/\@%:\@/#/g; |
| 591 | |
| 592 | $res = $_; |
| 593 | |
| 594 | # Don't complain in comments. Well, until we have something |
| 595 | # better, don't consider '#include' etc. are comments. |
| 596 | s/\#.*// |
| 597 | unless /^\#\s*(if|include|endif|ifdef|ifndef|define)\b/; |
| 598 | foreach (split (/\W+/)) |
| 599 | { |
| 600 | $prohibited{$_} = $. |
| 601 | if !/^$/ && /$forbidden/o && !/$allowed/o |
| 602 | && ! exists $prohibited{$_}; |
| 603 | } |
| 604 | |
| 605 | # Performed *last*: the empty quadrigraph. |
| 606 | $res =~ s/\@&t\@//g; |
| 607 | |
| 608 | print $out "$res\n"; |
| 609 | } |
| 610 | |
| 611 | $out->close(); |
| 612 | # Always update the file, even if it didn't change; |
| 613 | # Automake relies on this. |
| 614 | update_file ($scratchfile, $output, 1) |
| 615 | if defined $scratchfile; |
| 616 | |
| 617 | # If no forbidden words, we're done. |
| 618 | return |
| 619 | if ! %prohibited; |
| 620 | |
| 621 | # Locate the forbidden words in the last input file. |
| 622 | # This is unsatisfying but... |
| 623 | $exit_code = 1; |
| 624 | if ($ARGV[$#ARGV] ne '-') |
| 625 | { |
| 626 | my $prohibited = '\b(' . join ('|', keys %prohibited) . ')\b'; |
| 627 | my $file = new Autom4te::XFile ($ARGV[$#ARGV], "<"); |
| 628 | |
| 629 | while ($_ = $file->getline) |
| 630 | { |
| 631 | # Don't complain in comments. Well, until we have something |
| 632 | # better, don't consider '#include' etc. to be comments. |
| 633 | s/\#.*// |
| 634 | unless /^\#(if|include|endif|ifdef|ifndef|define)\b/; |
| 635 | |
| 636 | # Complain once per word, but possibly several times per line. |
| 637 | while (/$prohibited/) |
| 638 | { |
| 639 | my $word = $1; |
| 640 | warn_forbidden ("$ARGV[$#ARGV]:$.", $word, %forbidden); |
| 641 | delete $prohibited{$word}; |
| 642 | # If we're done, exit. |
| 643 | return |
| 644 | if ! %prohibited; |
| 645 | $prohibited = '\b(' . join ('|', keys %prohibited) . ')\b'; |
| 646 | } |
| 647 | } |
| 648 | } |
| 649 | warn_forbidden ("$output:$prohibited{$_}", $_, %forbidden) |
| 650 | foreach (sort { $prohibited{$a} <=> $prohibited{$b} } keys %prohibited); |
| 651 | } |
| 652 | |
| 653 | |
| 654 | ## --------------------- ## |
| 655 | ## Handling the traces. ## |
| 656 | ## --------------------- ## |
| 657 | |
| 658 | |
| 659 | # $M4_MACRO |
| 660 | # trace_format_to_m4 ($FORMAT) |
| 661 | # ---------------------------- |
| 662 | # Convert a trace $FORMAT into a M4 trace processing macro's body. |
| 663 | sub trace_format_to_m4 ($) |
| 664 | { |
| 665 | my ($format) = @_; |
| 666 | my $underscore = $_; |
| 667 | my %escape = (# File name. |
| 668 | 'f' => '$1', |
| 669 | # Line number. |
| 670 | 'l' => '$2', |
| 671 | # Depth. |
| 672 | 'd' => '$3', |
| 673 | # Name (also available as $0). |
| 674 | 'n' => '$4', |
| 675 | # Escaped dollar. |
| 676 | '$' => '$'); |
| 677 | |
| 678 | my $res = ''; |
| 679 | $_ = $format; |
| 680 | while ($_) |
| 681 | { |
| 682 | # $n -> $(n + 4) |
| 683 | if (s/^\$(\d+)//) |
| 684 | { |
| 685 | $res .= "\$" . ($1 + 4); |
| 686 | } |
| 687 | # $x, no separator given. |
| 688 | elsif (s/^\$([fldn\$])//) |
| 689 | { |
| 690 | $res .= $escape{$1}; |
| 691 | } |
| 692 | # $.x or ${sep}x. |
| 693 | elsif (s/^\$\{([^}]*)\}([@*%])// |
| 694 | || s/^\$(.?)([@*%])//) |
| 695 | { |
| 696 | # $@, list of quoted effective arguments. |
| 697 | if ($2 eq '@') |
| 698 | { |
| 699 | $res .= ']at_at([' . ($1 ? $1 : ',') . '], $@)['; |
| 700 | } |
| 701 | # $*, list of unquoted effective arguments. |
| 702 | elsif ($2 eq '*') |
| 703 | { |
| 704 | $res .= ']at_star([' . ($1 ? $1 : ',') . '], $@)['; |
| 705 | } |
| 706 | # $%, list of flattened unquoted effective arguments. |
| 707 | elsif ($2 eq '%') |
| 708 | { |
| 709 | $res .= ']at_percent([' . ($1 ? $1 : ':') . '], $@)['; |
| 710 | } |
| 711 | } |
| 712 | elsif (/^(\$.)/) |
| 713 | { |
| 714 | error "invalid escape: $1"; |
| 715 | } |
| 716 | else |
| 717 | { |
| 718 | s/^([^\$]+)//; |
| 719 | $res .= $1; |
| 720 | } |
| 721 | } |
| 722 | |
| 723 | $_ = $underscore; |
| 724 | return '[[' . $res . ']]'; |
| 725 | } |
| 726 | |
| 727 | |
| 728 | # handle_traces($REQ, $OUTPUT, %TRACE) |
| 729 | # ------------------------------------ |
| 730 | # We use M4 itself to process the traces. But to avoid name clashes when |
| 731 | # processing the traces, the builtins are disabled, and moved into 'at_'. |
| 732 | # Actually, all the low level processing macros are in 'at_' (and '_at_'). |
| 733 | # To avoid clashes between user macros and 'at_' macros, the macros which |
| 734 | # implement tracing are in 'AT_'. |
| 735 | # |
| 736 | # Having $REQ is needed to neutralize the macros which have been traced, |
| 737 | # but are not wanted now. |
| 738 | sub handle_traces ($$%) |
| 739 | { |
| 740 | my ($req, $output, %trace) = @_; |
| 741 | |
| 742 | verb "formatting traces for '$output': " . join (', ', sort keys %trace); |
| 743 | |
| 744 | # Processing the traces. |
| 745 | my $trace_m4 = new Autom4te::XFile ("$tmp/traces.m4", ">"); |
| 746 | |
| 747 | $_ = <<'EOF'; |
| 748 | divert(-1) |
| 749 | changequote([, ]) |
| 750 | # _at_MODE(SEPARATOR, ELT1, ELT2...) |
| 751 | # ---------------------------------- |
| 752 | # List the elements, separating then with SEPARATOR. |
| 753 | # MODE can be: |
| 754 | # 'at' -- the elements are enclosed in brackets. |
| 755 | # 'star' -- the elements are listed as are. |
| 756 | # 'percent' -- the elements are 'flattened': spaces are singled out, |
| 757 | # and no new line remains. |
| 758 | define([_at_at], |
| 759 | [at_ifelse([$#], [1], [], |
| 760 | [$#], [2], [[[$2]]], |
| 761 | [[[$2]][$1]$0([$1], at_shift(at_shift($@)))])]) |
| 762 | |
| 763 | define([_at_percent], |
| 764 | [at_ifelse([$#], [1], [], |
| 765 | [$#], [2], [at_flatten([$2])], |
| 766 | [at_flatten([$2])[$1]$0([$1], at_shift(at_shift($@)))])]) |
| 767 | |
| 768 | define([_at_star], |
| 769 | [at_ifelse([$#], [1], [], |
| 770 | [$#], [2], [[$2]], |
| 771 | [[$2][$1]$0([$1], at_shift(at_shift($@)))])]) |
| 772 | |
| 773 | # FLATTEN quotes its result. |
| 774 | # Note that the second pattern is 'newline, tab or space'. Don't lose |
| 775 | # the tab! |
| 776 | define([at_flatten], |
| 777 | [at_patsubst(at_patsubst([[[$1]]], [\\\n]), [[\n\t ]+], [ ])]) |
| 778 | |
| 779 | define([at_args], [at_shift(at_shift(at_shift(at_shift(at_shift($@)))))]) |
| 780 | define([at_at], [_$0([$1], at_args($@))]) |
| 781 | define([at_percent], [_$0([$1], at_args($@))]) |
| 782 | define([at_star], [_$0([$1], at_args($@))]) |
| 783 | |
| 784 | EOF |
| 785 | s/^ //mg;s/\\t/\t/mg;s/\\n/\n/mg; |
| 786 | print $trace_m4 $_; |
| 787 | |
| 788 | # If you trace 'define', then on 'define([m4_exit], defn([m4exit])' you |
| 789 | # will produce |
| 790 | # |
| 791 | # AT_define([m4sugar.m4], [115], [1], [define], [m4_exit], <m4exit>) |
| 792 | # |
| 793 | # Since '<m4exit>' is not quoted, the outer m4, when processing |
| 794 | # 'trace.m4' will exit prematurely. Hence, move all the builtins to |
| 795 | # the 'at_' name space. |
| 796 | |
| 797 | print $trace_m4 "# Copy the builtins.\n"; |
| 798 | map { print $trace_m4 "define([at_$_], defn([$_]))\n" } @m4_builtin; |
| 799 | print $trace_m4 "\n"; |
| 800 | |
| 801 | print $trace_m4 "# Disable them.\n"; |
| 802 | map { print $trace_m4 "at_undefine([$_])\n" } @m4_builtin; |
| 803 | print $trace_m4 "\n"; |
| 804 | |
| 805 | |
| 806 | # Neutralize traces: we don't want traces of cached requests (%REQUEST). |
| 807 | print $trace_m4 |
| 808 | "## -------------------------------------- ##\n", |
| 809 | "## By default neutralize all the traces. ##\n", |
| 810 | "## -------------------------------------- ##\n", |
| 811 | "\n"; |
| 812 | print $trace_m4 "at_define([AT_$_], [at_dnl])\n" |
| 813 | foreach (sort keys %{$req->macro}); |
| 814 | print $trace_m4 "\n"; |
| 815 | |
| 816 | # Implement traces for current requests (%TRACE). |
| 817 | print $trace_m4 |
| 818 | "## ------------------------- ##\n", |
| 819 | "## Trace processing macros. ##\n", |
| 820 | "## ------------------------- ##\n", |
| 821 | "\n"; |
| 822 | foreach (sort keys %trace) |
| 823 | { |
| 824 | # Trace request can be embed \n. |
| 825 | (my $comment = "Trace $_:$trace{$_}") =~ s/^/\# /; |
| 826 | print $trace_m4 "$comment\n"; |
| 827 | print $trace_m4 "at_define([AT_$_],\n"; |
| 828 | print $trace_m4 trace_format_to_m4 ($trace{$_}) . ")\n\n"; |
| 829 | } |
| 830 | print $trace_m4 "\n"; |
| 831 | |
| 832 | # Reenable output. |
| 833 | print $trace_m4 "at_divert(0)at_dnl\n"; |
| 834 | |
| 835 | # Transform the traces from m4 into an m4 input file. |
| 836 | # Typically, transform: |
| 837 | # |
| 838 | # | m4trace:configure.ac:3: -1- AC_SUBST([exec_prefix], [NONE]) |
| 839 | # |
| 840 | # into |
| 841 | # |
| 842 | # | AT_AC_SUBST([configure.ac], [3], [1], [AC_SUBST], [exec_prefix], [NONE]) |
| 843 | # |
| 844 | # Pay attention that the file name might include colons, if under DOS |
| 845 | # for instance, so we don't use '[^:]+'. |
| 846 | my $traces = new Autom4te::XFile ($tcache . $req->id, "<"); |
| 847 | while ($_ = $traces->getline) |
| 848 | { |
| 849 | # Trace with arguments, as the example above. We don't try |
| 850 | # to match the trailing parenthesis as it might be on a |
| 851 | # separate line. |
| 852 | s{^m4trace:(.+):(\d+): -(\d+)- ([^(]+)\((.*)$} |
| 853 | {AT_$4([$1], [$2], [$3], [$4], $5}; |
| 854 | # Traces without arguments, always on a single line. |
| 855 | s{^m4trace:(.+):(\d+): -(\d+)- ([^)]*)\n$} |
| 856 | {AT_$4([$1], [$2], [$3], [$4])\n}; |
| 857 | print $trace_m4 "$_"; |
| 858 | } |
| 859 | $trace_m4->close; |
| 860 | |
| 861 | my $in = new Autom4te::XFile ("$m4 " . shell_quote ("$tmp/traces.m4") . " |"); |
| 862 | my $out = new Autom4te::XFile; |
| 863 | if ($output eq '-') |
| 864 | { |
| 865 | $out->open (">$output"); |
| 866 | } |
| 867 | else |
| 868 | { |
| 869 | $out->open ($output, ">"); |
| 870 | } |
| 871 | |
| 872 | # This is dubious: should we really transform the quadrigraphs in |
| 873 | # traces? It might break balanced [ ] etc. in the output. The |
| 874 | # consensus seems to be that traces are more useful this way. |
| 875 | while ($_ = $in->getline) |
| 876 | { |
| 877 | # It makes no sense to try to transform __oline__. |
| 878 | s/\@<:\@/[/g; |
| 879 | s/\@:>\@/]/g; |
| 880 | s/\@\{:\@/(/g; |
| 881 | s/\@:\}\@/)/g; |
| 882 | s/\@S\|\@/\$/g; |
| 883 | s/\@%:\@/#/g; |
| 884 | s/\@&t\@//g; |
| 885 | print $out $_; |
| 886 | } |
| 887 | } |
| 888 | |
| 889 | |
| 890 | # $BOOL |
| 891 | # up_to_date ($REQ) |
| 892 | # ----------------- |
| 893 | # Are the cache files of $REQ up to date? |
| 894 | # $REQ is 'valid' if it corresponds to the request and exists, which |
| 895 | # does not mean it is up to date. It is up to date if, in addition, |
| 896 | # its files are younger than its dependencies. |
| 897 | sub up_to_date ($) |
| 898 | { |
| 899 | my ($req) = @_; |
| 900 | |
| 901 | return 0 |
| 902 | if ! $req->valid; |
| 903 | |
| 904 | my $tfile = $tcache . $req->id; |
| 905 | my $ofile = $ocache . $req->id; |
| 906 | |
| 907 | # We can't answer properly if the traces are not computed since we |
| 908 | # need to know what other files were included. Actually, if any of |
| 909 | # the cache files is missing, we are not up to date. |
| 910 | return 0 |
| 911 | if ! -f $tfile || ! -f $ofile; |
| 912 | |
| 913 | # The youngest of the cache files must be older than the oldest of |
| 914 | # the dependencies. |
| 915 | # FIXME: These timestamps have only 1-second resolution. |
| 916 | # Time::HiRes fixes this, but assumes Perl 5.8 or later. |
| 917 | my $tmtime = mtime ($tfile); |
| 918 | my $omtime = mtime ($ofile); |
| 919 | my ($file, $mtime) = ($tmtime < $omtime |
| 920 | ? ($ofile, $omtime) : ($tfile, $tmtime)); |
| 921 | |
| 922 | # stdin is always out of date. |
| 923 | if (grep { $_ eq '-' } @ARGV) |
| 924 | { return 0 } |
| 925 | |
| 926 | # We depend at least upon the arguments. |
| 927 | foreach my $dep (@ARGV) |
| 928 | { |
| 929 | if ($mtime < mtime ($dep)) |
| 930 | { |
| 931 | verb "up_to_date ($file): outdated: $dep"; |
| 932 | return 0; |
| 933 | } |
| 934 | } |
| 935 | |
| 936 | # Files may include others. We can use traces since we just checked |
| 937 | # if they are available. |
| 938 | handle_traces ($req, "$tmp/dependencies", |
| 939 | ('include' => '$1', |
| 940 | 'm4_include' => '$1')); |
| 941 | my $deps = new Autom4te::XFile ("$tmp/dependencies", "<"); |
| 942 | while ($_ = $deps->getline) |
| 943 | { |
| 944 | chomp; |
| 945 | my $dep = find_file ("$_?", @include); |
| 946 | # If a file which used to be included is no longer there, then |
| 947 | # don't say it's missing (it might no longer be included). But |
| 948 | # of course, that causes the output to be outdated (as if the |
| 949 | # timestamp of that missing file was newer). |
| 950 | return 0 |
| 951 | if ! $dep; |
| 952 | if ($mtime < mtime ($dep)) |
| 953 | { |
| 954 | verb "up_to_date ($file): outdated: $dep"; |
| 955 | return 0; |
| 956 | } |
| 957 | } |
| 958 | |
| 959 | verb "up_to_date ($file): up to date"; |
| 960 | return 1; |
| 961 | } |
| 962 | |
| 963 | |
| 964 | ## ---------- ## |
| 965 | ## Freezing. ## |
| 966 | ## ---------- ## |
| 967 | |
| 968 | # freeze ($OUTPUT) |
| 969 | # ---------------- |
| 970 | sub freeze ($) |
| 971 | { |
| 972 | my ($output) = @_; |
| 973 | |
| 974 | # When processing the file with diversion disabled, there must be no |
| 975 | # output but comments and empty lines. |
| 976 | my $result = xqx ("$m4" |
| 977 | . ' --fatal-warning' |
| 978 | . join (' --include=', '', map { shell_quote ($_) } @include) |
| 979 | . ' --define=divert' |
| 980 | . " " . files_to_options (@ARGV) |
| 981 | . ' </dev/null'); |
| 982 | $result =~ s/#.*\n//g; |
| 983 | $result =~ s/^\n//mg; |
| 984 | |
| 985 | fatal "freezing produced output:\n$result" |
| 986 | if $result; |
| 987 | |
| 988 | # If freezing produces output, something went wrong: a bad 'divert', |
| 989 | # or an improper paren etc. |
| 990 | xsystem ("$m4" |
| 991 | . ' --fatal-warning' |
| 992 | . join (' --include=', '', map { shell_quote ($_) } @include) |
| 993 | . " --freeze-state=" . shell_quote ($output) |
| 994 | . " " . files_to_options (@ARGV) |
| 995 | . ' </dev/null'); |
| 996 | } |
| 997 | |
| 998 | ## -------------- ## |
| 999 | ## Main program. ## |
| 1000 | ## -------------- ## |
| 1001 | |
| 1002 | mktmpdir ('am4t'); |
| 1003 | load_configuration ($ENV{'AUTOM4TE_CFG'} || "$pkgdatadir/autom4te.cfg"); |
| 1004 | load_configuration ("$ENV{'HOME'}/.autom4te.cfg") |
| 1005 | if exists $ENV{'HOME'} && -f "$ENV{'HOME'}/.autom4te.cfg"; |
| 1006 | load_configuration (".autom4te.cfg") |
| 1007 | if -f ".autom4te.cfg"; |
| 1008 | parse_args; |
| 1009 | |
| 1010 | # Freezing does not involve the cache. |
| 1011 | if ($freeze) |
| 1012 | { |
| 1013 | freeze ($output); |
| 1014 | exit $exit_code; |
| 1015 | } |
| 1016 | |
| 1017 | # Ensure the cache directory exists. |
| 1018 | if (! mkdir ($cache, 0755)) |
| 1019 | { |
| 1020 | # Snapshot $! immediately, the next few operations may clobber it. |
| 1021 | my $eexist = $!{EEXIST}; |
| 1022 | my $errmsg = "$!"; |
| 1023 | |
| 1024 | # If mkdir failed with EEXIST, that means the *name* $cache |
| 1025 | # already exists, but it might be the wrong kind of file. |
| 1026 | if (! $eexist || ! -d $cache) |
| 1027 | { |
| 1028 | require Cwd; |
| 1029 | my $cwd = Cwd::cwd(); |
| 1030 | fatal "cannot create $cache in $cwd: $errmsg"; |
| 1031 | } |
| 1032 | } |
| 1033 | |
| 1034 | # Open the index for update, and lock it. autom4te handles several |
| 1035 | # files, but the index is the first and last file to be updated, so |
| 1036 | # locking it is sufficient. |
| 1037 | $icache_file = new Autom4te::XFile $icache, O_RDWR|O_CREAT; |
| 1038 | $icache_file->lock (LOCK_EX) |
| 1039 | if ($flock_implemented eq "yes"); |
| 1040 | |
| 1041 | # Read the cache index if available and older than autom4te itself. |
| 1042 | # If autom4te is younger, then some structures such as C4che might |
| 1043 | # have changed, which would corrupt its processing. |
| 1044 | Autom4te::C4che->load ($icache_file) |
| 1045 | if (-f $icache && mtime ($icache) > mtime ($0) |
| 1046 | && Autom4te::C4che->good_version ($icache_file, '2.71')); |
| 1047 | |
| 1048 | # Add the new trace requests. |
| 1049 | my $req = Autom4te::C4che->request ('input' => \@ARGV, |
| 1050 | 'path' => \@include, |
| 1051 | 'macro' => [keys %trace, @preselect]); |
| 1052 | |
| 1053 | # If $REQ's cache files are not up to date, or simply if the user |
| 1054 | # discarded them (-f), declare it invalid. |
| 1055 | $req->valid (0) |
| 1056 | if $force || ! up_to_date ($req); |
| 1057 | |
| 1058 | # We now know whether we can trust the Request object. Say it. |
| 1059 | verb "the trace request object is:\n" . $req->marshall; |
| 1060 | |
| 1061 | # We need to run M4 if (i) the user wants it (--force), (ii) $REQ is |
| 1062 | # invalid. |
| 1063 | handle_m4 ($req, keys %{$req->macro}) |
| 1064 | if $force || ! $req->valid; |
| 1065 | |
| 1066 | # Issue the warnings each time autom4te was run. |
| 1067 | my $separator = "\n" . ('-' x 25) . " END OF WARNING " . ('-' x 25) . "\n\n"; |
| 1068 | handle_traces ($req, "$tmp/warnings", |
| 1069 | ('_m4_warn' => "\$1::\$f:\$l::\$2::\$3$separator")); |
| 1070 | # Swallow excessive newlines. |
| 1071 | for (split (/\n*$separator\n*/o, contents ("$tmp/warnings"))) |
| 1072 | { |
| 1073 | # The message looks like: |
| 1074 | # | syntax::input.as:5::ouch |
| 1075 | # | ::input.as:4: baz is expanded from... |
| 1076 | # | input.as:2: bar is expanded from... |
| 1077 | # | input.as:3: foo is expanded from... |
| 1078 | # | input.as:5: the top level |
| 1079 | # In particular, m4_warn guarantees that either $stackdump is empty, or |
| 1080 | # it consists of lines where only the last line ends in "top level". |
| 1081 | my ($cat, $loc, $msg, $stacktrace) = split ('::', $_, 4); |
| 1082 | # There might not have been a stacktrace. |
| 1083 | $stacktrace = '' unless defined $stacktrace; |
| 1084 | msg $cat, $loc, $msg, |
| 1085 | partial => ($stacktrace =~ /top level$/) + 0; |
| 1086 | for (split /\n/, $stacktrace) |
| 1087 | { |
| 1088 | my ($loc, $trace) = split (': ', $_, 2); |
| 1089 | msg $cat, $loc, $trace, partial => ($trace !~ /top level$/) + 0; |
| 1090 | } |
| 1091 | } |
| 1092 | |
| 1093 | # Now output... |
| 1094 | if (%trace) |
| 1095 | { |
| 1096 | # Always produce traces, since even if the output is young enough, |
| 1097 | # there is no guarantee that the traces use the same *format* |
| 1098 | # (e.g., '-t FOO:foo' and '-t FOO:bar' are both using the same M4 |
| 1099 | # traces, hence the M4 traces cache is usable, but its formatting |
| 1100 | # will yield different results). |
| 1101 | handle_traces ($req, $output, %trace); |
| 1102 | } |
| 1103 | else |
| 1104 | { |
| 1105 | # Actual M4 expansion, if the user wants it, or if $output is old |
| 1106 | # (STDOUT is pretty old). |
| 1107 | handle_output ($req, $output) |
| 1108 | if $force || mtime ($output) < mtime ($ocache . $req->id); |
| 1109 | } |
| 1110 | |
| 1111 | # If we ran up to here, the cache is valid. |
| 1112 | $req->valid (1); |
| 1113 | Autom4te::C4che->save ($icache_file, '2.71'); |
| 1114 | |
| 1115 | exit $exit_code; |
| 1116 | |
| 1117 | ### Setup "GNU" style for perl-mode and cperl-mode. |
| 1118 | ## Local Variables: |
| 1119 | ## perl-indent-level: 2 |
| 1120 | ## perl-continued-statement-offset: 2 |
| 1121 | ## perl-continued-brace-offset: 0 |
| 1122 | ## perl-brace-offset: 0 |
| 1123 | ## perl-brace-imaginary-offset: 0 |
| 1124 | ## perl-label-offset: -2 |
| 1125 | ## cperl-indent-level: 2 |
| 1126 | ## cperl-brace-offset: 0 |
| 1127 | ## cperl-continued-brace-offset: 0 |
| 1128 | ## cperl-label-offset: -2 |
| 1129 | ## cperl-extra-newline-before-brace: t |
| 1130 | ## cperl-merge-trailing-else: nil |
| 1131 | ## cperl-continued-statement-offset: 2 |
| 1132 | ## End: |