bin/autom4te.in

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