mirror/autoconf
2
0
Fork 0
mirror of git://git.sv.gnu.org/autoconf synced 2024-12-15 02:20:10 +08:00
Code Issues Packages Projects Releases Wiki Activity
788b2078c0
autoconf/bin/autom4te.in
Akim Demaille 788b2078c0 * bin/autoreconf.in: Rewrite in Perl. 
* configure.ac: Adjust.
* lib/Autom4te/General.pm (&up_to_date_p): New.
* bin/autom4te.in (&up_to_date_p): Use it.
Rename as...
(&up_to_date): this.
2001-10-08 08:25:44 +00:00

1057 lines
28 KiB
Perl
Raw Blame History

#! @PERL@ -w
# -*- perl -*-
# @configure_input@
eval 'exec @PERL@ -S $0 ${1+"$@"}'
if 0;
# autom4te - Wrapper around M4 libraries.
# Copyright 2001 Free Software Foundation, Inc.
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
# 02111-1307, USA.
BEGIN
{
my $datadir = ($ENV{'autom4te_perllibdir'} || '@datadir@');
unshift @INC, "$datadir";
}
## --------- ##
## Request. ##
## --------- ##
package Request;
use Data::Dumper;
use Autom4te::General;
use Autom4te::Struct;
use Autom4te::XFile;
use Carp;
use strict;
# List of requests.
# We can't declare it `my' as the loading, performed via `do',
# would refer to another scope, and @request would not be updated.
# It used to work with `my' vars, and I don't know whether the current
# behavior (5.6) is wanted or not.
use vars qw(@request);
struct
(
# The key of the cache files.
'id' => "\$",
# True iff %MACRO contains all the macros we want to trace.
'valid' => "\$",
# The include path.
'path' => '@',
# The set of input files.
'input' => '@',
# The set of macros currently traced.
'macro' => '%',
);
# $REQUEST-OBJ
# retrieve ($SELF, %ATTR)
# -----------------------
# Find a request with the same path and input.
# Private.
sub retrieve
{
my ($self, %attr) = @_;
foreach (@request)
{
# Same path.
next
if join ("\n", @{$_->path}) ne join ("\n", @{$attr{path}});
# Same inputs.
next
if join ("\n", @{$_->input}) ne join ("\n", @{$attr{input}});
# Found it.
return $_;
}
return undef;
}
# $REQUEST-OBJ
# register ($SELF, %ATTR)
# -----------------------
# NEW should not be called directly.
# Private.
sub register ($%)
{
my ($self, %attr) = @_;
# path and input are the only ID for a request object.
my $obj = $self->new ('path' => $attr{path},
'input' => $attr{input});
push @request, $obj;
# Assign an id for cache file.
$obj->id ("$#request");
return $obj;
}
# $REQUEST-OBJ
# request($SELF, %REQUEST)
# ------------------------
# Return a request corresponding to $REQUEST{path} and $REQUEST{input},
# using a cache value if it exists.
sub request ($%)
{
my ($self, %request) = @_;
my $req = Request->retrieve (%request) || Request->register (%request);
# If there are new traces to produce, then we are not valid.
foreach (@{$request{'macro'}})
{
if (! exists ${$req->macro}{$_})
{
${$req->macro}{$_} = 1;
$req->valid (0);
}
}
# It would be great to have $REQ check that it up to date wrt its
# dependencies, but that requires gettting traces (to fetch the
# included files), which is out of the scope of Request
# (currently?).
return $req;
}
# Serialize a request or all the current requests.
sub marshall
{
my ($caller) = @_;
my $res = '';
if (ref ($caller))
{
# CALLER is an object: instance method.
my $marshall = Data::Dumper->new ([$caller]);
$marshall->Indent(2)->Terse(0);
$res = $marshall->Dump . "\n";
}
else
{
# CALLER is the package: class method.
my $marshall = Data::Dumper->new ([\@request], [qw (*request)]);
$marshall->Indent(2)->Terse(0);
$res = $marshall->Dump . "\n";
}
return $res;
}
# includes_p (@MACRO)
# -------------------
# Does this request covers all the @MACRO.
sub includes_p
{
my ($self, @macro) = @_;
foreach (@macro)
{
return 0
if ! exists ${$self->macro}{$_};
}
return 1;
}
# SAVE ($FILENAME)
# ----------------
sub save
{
my ($self, $filename) = @_;
croak "$me: cannot save a single request\n"
if ref ($self);
my $requests = new Autom4te::XFile ("> $filename");
print $requests
"# This file was created by $me.\n",
"# It contains the lists of macros which have been traced.\n",
"# It can be safely removed.\n",
"\n",
$self->marshall;
}
# LOAD ($FILE)
# ------------
sub load
{
my ($self, $file) = @_;
croak "$me: cannot load a single request\n"
if ref ($self);
(my $return) = do "$file";
croak "$me: cannot parse $file: $@\n" if $@;
croak "$me: cannot do $file: $!\n" if $!;
croak "$me: cannot run $file\n" unless $return;
}
## ---------- ##
## Autom4te. ##
## ---------- ##
package Autom4te;
use Autom4te::General;
use File::Basename;
use Autom4te::XFile;
use strict;
# Configuration file.
my $datadir = $ENV{'AC_MACRODIR'} || '@datadir@';
my $autom4te_cfg = $ENV{'AUTOM4TE_CFG'} || "$datadir/autom4te.cfg";
# $LANGUAGE{LANGUAGE} -- Automatic options for LANGUAGE.
my %language;
my $output = '-';
# Should we normalize the output?
my $normalize = 0;
# Mode of the output file except for traces.
my $mode = "0666";
# If melt, don't use frozen files.
my $melt = 0;
# Names of the cache directory, cache directory index, trace cache
# prefix, and output cache prefix.
my $cache = "$me.cache";
my $icache = "$cache/requests";
my $tcache = "$cache/traces.";
my $ocache = "$cache/output.";
# The macros to trace mapped to their format, as specified by the
# user.
my %trace;
# The macros the user will want to trace in the future.
# We need `include' to get the included file, `m4_pattern_forbid' and
# `m4_pattern_allow' to check the output.
#
# FIXME: What about `sinclude'?
my @preselect = ('include', 'm4_pattern_allow', 'm4_pattern_forbid');
# List of warnings.
my @warning;
# M4 include path.
my @include;
# 0 for EXIT_SUCCESS.
my $exit_status = 0;
# If true, don't rely on the cache (but still update it).
my $force = 0;
# $M4.
my $m4 = $ENV{"M4"} || '@M4@';
# Some non-GNU m4's don't reject the --help option, so give them /dev/null.
die "$me: need GNU m4 1.4 or later: $m4\n"
if system "$m4 --help </dev/null 2>&1 | fgrep reload-state >/dev/null";
# Set some high recursion limit as the default limit, 250, has already
# been hit with AC_OUTPUT. Don't override the user's choice.
$m4 .= ' --nesting-limit=1024'
if " $m4 " !~ / (--nesting-limit|-L) /;
# @M4_BUILTIN -- M4 builtins and a useful comment.
my @m4_builtin = `echo dumpdef | $m4 2>&1 >/dev/null`;
map { s/:.*//;s/\W// } @m4_builtin;
# %M4_BUILTIN_ALTERNATE_NAME
# --------------------------
# The builtins are renamed, e.g., `define' is renamed `m4_define'.
# So map `define' to `m4_define' and conversely.
# Some macros don't follow this scheme: be sure to properly map to their
# alternate name too.
#
# This is because GNU M4 1.4's tracing of builtins is buggy. When run on
# this input:
#
# | divert(-1)
# | changequote([, ])
# | define([m4_eval], defn([eval]))
# | eval(1)
# | m4_eval(2)
# | undefine([eval])
# | m4_eval(3)
#
# it behaves this way:
#
# | % m4 input.m4 -da -t eval
# | m4trace: -1- eval(1)
# | m4trace: -1- m4_eval(2)
# | m4trace: -1- m4_eval(3)
# | %
#
# Conversely:
#
# | % m4 input.m4 -da -t m4_eval
# | %
#
# So we will merge them, i.e. tracing `BUILTIN' or tracing
# `m4_BUILTIN' will be the same: tracing both, but honoring the
# *last* trace specification.
#
# FIXME: This is not enough: in the output `$0' will be `BUILTIN'
# sometimes and `m4_BUILTIN' at others. We should return a unique name,
# the one specified by the user.
#
# FIXME: To be absolutely rigorous, I would say that given that we
# _redefine_ divert (instead of _copying_ it), divert and the like
# should not be part of this list.
my %m4_builtin_alternate_name;
@m4_builtin_alternate_name{"$_", "m4_$_"} = ("m4_$_", "$_")
foreach (grep { !/m4wrap|m4exit|dnl|ifelse|__.*__/ } @m4_builtin);
@m4_builtin_alternate_name{"ifelse", "m4_if"} = ("m4_if", "ifelse");
@m4_builtin_alternate_name{"m4exit", "m4_exit"} = ("m4_exit", "m4exit");
@m4_builtin_alternate_name{"m4wrap", "m4_wrap"} = ("m4_wrap", "m4wrap");
# $HELP
# -----
$help = << "EOF";
Usage: $0 [OPTION] ... [FILES]
Run GNU M4 on the FILES, avoiding useless runs. If tracing, the output
consists of the traces only, otherwise output the expansion of the FILES.
The first of the FILES may be an M4 frozen file, but then must end in \`.m4f\'.
Some files may be optional, i.e., will only be processed if found in the
include path, but then must end in \`.m4?\'; the question mark is not part of
the actual file name.
Operation modes:
-h, --help print this help, then exit
-V, --version print version number, then exit
-v, --verbose verbosely report processing
-d, --debug don\'t remove temporary files
-o, --output=FILE save output in FILE (defaults to \`-\', stdout)
--normalize smash successive empty lines
-f, --force don\'t rely on cached values
-W, --warnings=CATEGORY report the warnings falling in CATEGORY
-l, --language=LANG specify the set of M4 macros to use
-m, --mode=OCTAL change the non trace output file mode (0666)
-M, --melt don\'t use M4 frozen files
Languages include:
\`Autoconf\' create Autoconf configure scripts
\`Autotest\' create Autotest test suites
\`M4sh\' create M4sh shell scripts
\`M4sugar\' create M4sugar output
Warning categories include:
\`cross\' cross compilation issues
\`obsolete\' obsolete constructs
\`syntax\' dubious syntactic constructs
\`all\' all the warnings
\`no-CATEGORY\' turn off the warnings on CATEGORY
\`none\' turn off all the warnings
\`error\' warnings are error
The environment variable \`WARNINGS\' is honored.
Library directories:
-I, --include=DIR look for FILES in DIR (cumulative)
Tracing:
-t, --trace=MACRO report the MACRO invocations
-p, --preselect=MACRO prepare to trace MACRO in a future run
Report bugs to <bug-autoconf\@gnu.org>.
EOF
# $VERSION
# --------
$version = <<"EOF";
autom4te (@PACKAGE_NAME@) @VERSION@
Written by Akim Demaille.
Copyright 2001 Free Software Foundation, Inc.
This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
EOF
## ---------- ##
## Routines. ##
## ---------- ##
# load_configuration ()
# ---------------------
# Load the configuration file.
sub load_configuration ()
{
use Text::ParseWords;
my $cfg = new Autom4te::XFile ($autom4te_cfg);
my $lang;
while ($_ = $cfg->getline)
{
chomp;
# Comments.
next
if /^\s*(\#.*)?$/;
my @words = shellwords ($_);
my $type = shift @words;
if ($type eq 'begin-language:')
{
$lang = lc $words[0];
}
elsif ($type eq 'end-language:')
{
die "$me: $autom4te_cfg:$.: end-language mismatch: $lang\n"
if $lang ne lc $words[0];
}
elsif ($type eq 'args:')
{
push @{$language{$lang}}, @words;
}
else
{
die "$me: $autom4te_cfg:$.: unknown directive: $type\n";
}
}
}
# parse_args ()
# -------------
# Process any command line arguments.
sub parse_args ()
{
# We want to look for the early options, which should not be found
# in the configuration file. Prepend to the user arguments.
# Perform this repeatedly so that we can use --language in language
# definitions. Beware that there can be several --language
# invocations.
my @language;
do {
@language = ();
Getopt::Long::Configure ("pass_through");
getopt ("l|language=s" => \@language);
foreach (@language)
{
die "$me: unknown language: $_\n"
unless exists $language{lc $_};
unshift @ARGV, @{$language{lc $_}};
}
} while @language;
debug "arguments: @ARGV\n";
# Process the arguments for real this time.
my @trace;
Getopt::Long::Configure ("defaults");
getopt
(
# Operation modes:
"o|output=s" => \$output,
"normalize" => \$normalize,
"f|force" => \$force,
"W|warnings=s" => \@warning,
"m|mode=s" => \$mode,
"M|melt" => \$melt,
# Library directories:
"I|include=s" => \@include,
# Tracing:
# Using a hash for traces is seducing. Unfortunately, upon `-t FOO',
# instead of mapping `FOO' to undef, Getopt maps it to `1', preventing
# us from distinguishing `-t FOO' from `-t FOO=1'. So let's do it
# by hand.
"t|trace=s" => \@trace,
"p|preselect=s" => \@preselect,
);
die "$me: too few arguments
Try `$me --help' for more information.\n"
unless @ARGV;
# Normalize the includes: the first occurrence is enough, several is
# a pain since it introduces a useless difference in the path which
# invalidates the cache. And strip `.' which is implicit and always
# first.
@include = grep { !/^\.$/ } uniq (@include);
# Convert @trace to %trace, and work around the M4 builtins tracing
# problem.
# The default format is `$f:$l:$n:$%'.
foreach (@trace)
{
/^([^:]+)(?::(.*))?$/ms;
$trace{$1} = defined $2 ? $2 : '$f:$l:$n:$%';
$trace{$m4_builtin_alternate_name{$1}} = $trace{$1}
if exists $m4_builtin_alternate_name{$1};
}
# Work around the M4 builtins tracing problem for @PRESELECT.
push (@preselect,
map { $m4_builtin_alternate_name{$_} }
grep { exists $m4_builtin_alternate_name{$_} } @preselect);
# Only the first file can be frozen, but M4 doesn't complain if this
# constraint is not honored.
die "$me: the first file only can be frozen\n"
if grep { /\.m4f/ } @ARGV[1 .. $#ARGV];
$ARGV[0] =~ s/\.m4f$/.m4/
if $melt;
# We don't want to depend upon m4's --include to find the top level
# files. Try to get a canonical name, as it's part of the key for
# caching. And some files are optional.
@ARGV = grep { defined $_ } map { find_file ($_, @include) } @ARGV;
}
# handle_m4 ($REQ, @MACRO)
# ------------------------
# Run m4 on the input files, and save the traces on the @MACRO.
sub handle_m4 ($@)
{
my ($req, @macro) = @_;
my $files;
foreach (@ARGV)
{
$files .= ' ';
$files .= '--reload-state='
if /\.m4f$/;
$files .= "$_";
}
# The warnings are the concatenation of 1. application's defaults,
# 2. $WARNINGS, $3 command line options, in that order.
# Set them in the order expected by the M4 macros: the converse.
my $m4_warnings =
lc join (',', reverse (split (',', ($ENV{'WARNINGS'} || '')),
map { split /,/ } @warning));
# GNU m4 appends when using --error-output.
unlink ($tcache . $req->id);
# Run m4.
#
# Neutralize its stdin, so that GNU M4 1.5 doesn't neutralize SIGINT.
#
# Be extremely cautious to reverse the includes when talking to M4:
# it doesn't speak the same --include as we do.
my $command = ("$m4"
. join (' --include=', '', reverse @include)
. " --define=m4_warnings=$m4_warnings"
. ' --debug=aflq'
. " --error-output=$tcache" . $req->id
. join (' --trace=', '', sort @macro)
. $files
. ' </dev/null'
. " >$ocache" . $req->id);
verbose "running: $command";
system $command;
if ($?)
{
verbose "$m4: failed with exit status: " . ($? >> 8) . "\n";
exit $? >> 8;
}
}
# handle_output ($REQ, $OUTPUT)
# -----------------------------
# Run m4 on the input files, perform quadrigraphs substitution, check for
# forbidden tokens, and save into $OUTPUT.
sub handle_output ($$)
{
my ($req, $output) = @_;
verbose "creating $output";
# Load the forbidden/allowed patterns.
handle_traces ($req, "$tmp/patterns",
('m4_pattern_forbid' => 'forbid:$1',
'm4_pattern_allow' => 'allow:$1'));
my @patterns = new Autom4te::XFile ("$tmp/patterns")->getlines;
chomp @patterns;
my $forbidden = join ('|', map { /^forbid:(.*)/ } @patterns) || "^\$";
my $allowed = join ('|', map { /^allow:(.*)/ } @patterns) || "^\$";
verbose "forbidden tokens: $forbidden";
verbose "allowed tokens: $allowed";
# Read the (cached) raw M4 output, produce the actual result. We
# have to use the 2nd arg to have Autom4te::XFile honor the third, but then
# stdout is to be handled by hand :(. Don't use fdopen as it means
# we will close STDOUT, which we already do in END.
my $out = new Autom4te::XFile;
if ($output eq '-')
{
$out->open (">$output");
}
else
{
$out->open($output, O_CREAT | O_WRONLY | O_TRUNC, oct ($mode));
}
die "$me: cannot create $output: $!\n"
unless $out;
my $in = new Autom4te::XFile ($ocache . $req->id);
my $separate = 0;
my $oline = 0;
my %prohibited;
my $res;
while ($_ = $in->getline)
{
s/\s+$//;
if ($normalize && /^$/)
{
$separate = 1;
next;
}
if ($separate)
{
$oline++;
print $out "\n";
}
$separate = 0;
$oline++;
s/__oline__/$oline/g;
s/\@<:\@/[/g;
s/\@:>\@/]/g;
s/\@S\|\@/\$/g;
s/\@%:\@/#/g;
$res = $_;
# Don't complain in comments. Well, until we have something
# better, don't consider `#include' etc. are comments.
s/\#.*//
unless /^\#\s*(if|include|endif|ifdef|ifndef|define)\b/;
foreach (split (/\W+/))
{
$prohibited{$_} = $oline
if /$forbidden/o && !/$allowed/o && ! exists $prohibited{$_};
}
# Performed *last*: the empty quadrigraph.
$res =~ s/\@&t\@//g;
print $out "$res\n";
}
# If no forbidden words, we're done.
return
if ! %prohibited;
# Locate the forbidden words in the last input file.
# This is unsatisfying but...
my $prohibited = '\b(' . join ('|', keys %prohibited) . ')\b';
my $file = new Autom4te::XFile ($ARGV[$#ARGV]);
$exit_status = 1;
while ($_ = $file->getline)
{
# Don't complain in comments. Well, until we have something
# better, don't consider `#include' etc. are comments.
s/\#.*//
unless /^\#(if|include|endif|ifdef|ifndef|define)\b/;
# Complain once per word, but possibly several times per line.
while (/$prohibited/)
{
warn "$ARGV[$#ARGV]:$.: error: possibly undefined macro: $1\n";
delete $prohibited{$1};
# If we're done, exit.
return
if ! %prohibited;
$prohibited = '\b(' . join ('|', keys %prohibited) . ')\b';
}
}
warn "$output:$prohibited{$_}: error: possibly undefined macro: $_\n"
foreach (sort { $prohibited{$a} <=> $prohibited{$b} } keys %prohibited);
}
## --------------------- ##
## Handling the traces. ##
## --------------------- ##
# $M4_MACRO
# trace_format_to_m4 ($FORMAT)
# ----------------------------
# Convert a trace $FORMAT into a M4 trace processing macro's body.
sub trace_format_to_m4 ($)
{
my ($format) = @_;
my $underscore = $_;
my %escape = (# File name.
'f' => '$1',
# Line number.
'l' => '$2',
# Depth.
'd' => '$3',
# Name (also available as $0).
'n' => '$4',
# Escaped dollar.
'$' => '$');
my $res = '';
$_ = $format;
while ($_)
{
# $n -> $(n + 4)
if (s/^\$(\d+)//)
{
$res .= "\$" . ($1 + 4);
}
# $x, no separator given.
elsif (s/^\$([fldn\$])//)
{
$res .= $escape{$1};
}
# $.x or ${sep}x.
elsif (s/^\$\{([^}]*)\}([@*%])//
|| s/^\$(.?)([@*%])//)
{
# $@, list of quoted effective arguments.
if ($2 eq '@')
{
$res .= ']at_at([' . ($1 ? $1 : ',') . '], $@)[';
}
# $*, list of unquoted effective arguments.
elsif ($2 eq '*')
{
$res .= ']at_star([' . ($1 ? $1 : ',') . '], $@)[';
}
# $%, list of flattened unquoted effective arguments.
elsif ($2 eq '%')
{
$res .= ']at_percent([' . ($1 ? $1 : ':') . '], $@)[';
}
}
elsif (/^(\$.)/)
{
die "$me: invalid escape: $1\n";
}
else
{
s/^([^\$]+)//;
$res .= $1;
}
}
$_ = $underscore;
return '[[' . $res . ']]';
}
# handle_traces($REQ, $OUTPUT, %TRACE)
# ------------------------------------
# We use M4 itself to process the traces. But to avoid name clashes when
# processing the traces, the builtins are disabled, and moved into `at_'.
# Actually, all the low level processing macros are in `at_' (and `_at_').
# To avoid clashes between user macros and `at_' macros, the macros which
# implement tracing are in `AT_'.
#
# Having $REQ is needed to neutralize the macros which have been traced,
# but are not wanted now.
sub handle_traces ($$%)
{
my ($req, $output, %trace) = @_;
verbose "formatting traces for `$output': ", join (', ', sort keys %trace);
# Processing the traces.
my $trace_m4 = new Autom4te::XFile (">$tmp/traces.m4");
$_ = <<'EOF';
divert(-1)
changequote([, ])
# _at_MODE(SEPARATOR, ELT1, ELT2...)
# ----------------------------------
# List the elements, separating then with SEPARATOR.
# MODE can be:
# `at' -- the elements are enclosed in brackets.
# `star' -- the elements are listed as are.
# `percent' -- the elements are `flattened': spaces are singled out,
# and no new line remains.
define([_at_at],
[at_ifelse([$#], [1], [],
[$#], [2], [[[$2]]],
[[[$2]][$1]$0([$1], at_shift(at_shift($@)))])])
define([_at_percent],
[at_ifelse([$#], [1], [],
[$#], [2], [at_flatten([$2])],
[at_flatten([$2])[$1]$0([$1], at_shift(at_shift($@)))])])
define([_at_star],
[at_ifelse([$#], [1], [],
[$#], [2], [[$2]],
[[$2][$1]$0([$1], at_shift(at_shift($@)))])])
# FLATTEN quotes its result.
# Note that the second pattern is `newline, tab or space'. Don't lose
# the tab!
define([at_flatten],
[at_patsubst(at_patsubst(at_patsubst([[[$1]]], [\\\n]),
[[\n\t ]+], [ ]),
[^ *\(.*\) *$], [[\1]])])
define([at_args], [at_shift(at_shift(at_shift(at_shift(at_shift($@)))))])
define([at_at], [_$0([$1], at_args($@))])
define([at_percent], [_$0([$1], at_args($@))])
define([at_star], [_$0([$1], at_args($@))])
EOF
s/^ //mg;s/\\t/\t/mg;s/\\n/\n/mg;
print $trace_m4 $_;
# If you trace `define', then on `define([m4_exit], defn([m4exit])' you
# will produce
#
# AT_define([m4sugar.m4], [115], [1], [define], [m4_exit], <m4exit>)
#
# Since `<m4exit>' is not quoted, the outer m4, when processing
# `trace.m4' will exit prematurely. Hence, move all the builtins to
# the `at_' name space.
print $trace_m4 "# Copy the builtins.\n";
map { print $trace_m4 "define([at_$_], defn([$_]))\n" } @m4_builtin;
print $trace_m4 "\n";
print $trace_m4 "# Disable them.\n";
map { print $trace_m4 "at_undefine([$_])\n" } @m4_builtin;
print $trace_m4 "\n";
# Neutralize traces: we don't want traces of cached requests (%REQUEST).
print $trace_m4
"## -------------------------------------- ##\n",
"## By default neutralize all the traces. ##\n",
"## -------------------------------------- ##\n",
"\n";
print $trace_m4 "at_define([AT_$_], [at_dnl])\n"
foreach (sort keys %{$req->macro});
print $trace_m4 "\n";
# Implement traces for current requests (%TRACE).
print $trace_m4
"## ------------------------- ##\n",
"## Trace processing macros. ##\n",
"## ------------------------- ##\n",
"\n";
foreach (sort keys %trace)
{
# Trace request can be embed \n.
(my $comment = "Trace $_:$trace{$_}") =~ s/^/\# /;
print $trace_m4 "$comment\n";
print $trace_m4 "at_define([AT_$_],\n";
print $trace_m4 trace_format_to_m4 ($trace{$_}) . ")\n\n";
}
print $trace_m4 "\n";
# Reenable output.
print $trace_m4 "at_divert(0)at_dnl\n";
# Transform the traces from m4 into an m4 input file.
# Typically, transform:
#
# | m4trace:configure.ac:3: -1- AC_SUBST([exec_prefix], [NONE])
#
# into
#
# | AT_AC_SUBST([configure.ac], [3], [1], [AC_SUBST], [exec_prefix], [NONE])
#
# Pay attention that the file name might include colons, if under DOS
# for instance, so we don't use `[^:]+'.
my $traces = new Autom4te::XFile ($tcache . $req->id);
while ($_ = $traces->getline)
{
# Trace with arguments, as the example above. We don't try
# to match the trailing parenthesis as it might be on a
# separate line.
s{^m4trace:(.+):(\d+): -(\d+)- ([^(]+)\((.*)$}
{AT_$4([$1], [$2], [$3], [$4], $5};
# Traces without arguments, always on a single line.
s{^m4trace:(.+):(\d+): -(\d+)- ([^)]*)\n$}
{AT_$4([$1], [$2], [$3], [$4])\n};
print $trace_m4 "$_";
}
$trace_m4->close;
my $in = new Autom4te::XFile ("$m4 $tmp/traces.m4 |");
my $out = new Autom4te::XFile (">$output");
# FIXME: Hm... This is dubious: should we really transform the
# quadrigraphs in traces? It might break balanced [ ] etc. in the
# output.
while ($_ = $in->getline)
{
# It makes no sense to try to transform __oline__.
s/\@<:\@/[/g;
s/\@:>\@/]/g;
s/\@\$\|\@/\$/g;
s/\@%:\@/#/g;
print $out $_;
}
}
# $BOOL
# up_to_date ($REQ)
# -----------------
# Are the cache files of $REQ up to date?
# $REQ is `valid' if it corresponds to the request and exists, which
# does not mean it is up to date. It is up to date if, in addition,
# its files are younger than its dependencies.
sub up_to_date ($)
{
my ($req) = @_;
return 0
if ! $req->valid;
my $tfile = $tcache . $req->id;
my $ofile = $ocache . $req->id;
# We can't answer properly if the traces are not computed since we
# need to know what other files were included. Actually, if any of
# the cache files is missing, we are not up to date.
return 0
if ! -f $tfile || ! -f $ofile;
# The youngest of the cache files must be older than the oldest of
# the dependencies.
my $tmtime = mtime ($tfile);
my $omtime = mtime ($ofile);
my ($file, $mtime) = ($tmtime < $omtime
? ($ofile, $omtime) : ($tfile, $tmtime));
# We depend at least upon the arguments.
my @dep = @ARGV;
# Files may include others. We can use traces since we just checked
# if they are available.
handle_traces ($req, "$tmp/dependencies",
('include' => '$1',
'm4_include' => '$1'));
my $deps = new Autom4te::XFile ("$tmp/dependencies");
push @dep, map { chomp; find_file ($_, @include) } $deps->getlines;
# If $FILE is younger than one of its dependencies, it is outdated.
return up_to_date_p ($file, @dep);
}
## -------------- ##
## Main program. ##
## -------------- ##
mktmpdir ('t4');
load_configuration;
parse_args;
# We need our cache directory.
if (! -d "$cache")
{
mkdir "$cache", 0755
or die "$me: cannot create $cache: $!\n";
}
# Read the cache index if available and older than autom4te itself.
# If autom4te is younger, then some structures such as Request, might
# have changed, which would corrupt its processing.
Request->load ($icache)
if -f $icache && mtime ($icache) > mtime ($0);
# Add the new trace requests.
my $req = Request->request ('input' => \@ARGV,
'path' => \@include,
'macro' => [keys %trace, @preselect]);
# If $REQ's cache files are not up to date, declare it invalid.
$req->valid (0)
if ! up_to_date ($req);
# We now know whether we can trust the Request object. Say it.
if ($verbose)
{
print STDERR "$me: the trace request object is:\n";
print STDERR $req->marshall;
}
# We need to run M4 if (i) the users wants it (--force), (ii) $REQ is
# invalid.
handle_m4 ($req, keys %{$req->macro})
if $force || ! $req->valid;
# Now output...
if (%trace)
{
# Always produce traces, since even if the output is young enough,
# there is no guarantee that the traces use the same *format*
# (e.g., `-t FOO:foo' and `-t FOO:bar' are both using the same M4
# traces, hence the M4 traces cache is usable, but its formating
# will yield different results).
handle_traces ($req, $output, %trace);
}
else
{
# Actual M4 expansion, only if $output is too old. STDOUT is
# pretty old.
handle_output ($req, $output)
if mtime ($output) < mtime ($ocache . $req->id);
}
# If all went fine, the cache is valid.
$req->valid (1)
if $exit_status == 0;
Request->save ($icache);
exit $exit_status;
Reference in New Issue View Git Blame Copy Permalink