bin/autom4te.in

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