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