bin/autom4te

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