mirror of
git://git.sv.gnu.org/autoconf
synced 2024-12-15 02:20:10 +08:00
cd0e85de14
Map --localdir, --autoconf-dir onto it. Forward autom4te's options instead of interpreting them. * bin/autoconf.in, bin/autoheader.in (AC_MACRODIR, autoconf_dir): There is no such envvar since the inception of autom4te.cfg. * bin/autom4te.in (&parse_args): Uniquify `@include'. * bin/autoupdate.in: Adjust, and perform more control. * tests/atspecific.m4 (AT_CHECK_AUTOCONF): Adjust. * tests/autoconf: Dittowise.
1154 lines
30 KiB
Perl
1154 lines
30 KiB
Perl
#! @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'}
|
|
|| $ENV{'AC_MACRODIR'}
|
|
|| '@datadir@');
|
|
unshift @INC, "$datadir";
|
|
}
|
|
|
|
## --------- ##
|
|
## Request. ##
|
|
## --------- ##
|
|
|
|
package Request;
|
|
|
|
use Data::Dumper;
|
|
use Autom4te::General;
|
|
use Autom4te::Struct;
|
|
use Carp;
|
|
use Getopt::Long;
|
|
use IO::File;
|
|
use File::Spec;
|
|
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 IO::File ("> $filename")
|
|
or die "$me: cannot create $filename: $!\n";
|
|
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 Getopt::Long;
|
|
use File::Basename;
|
|
use IO::File;
|
|
use strict;
|
|
|
|
# Configuration file.
|
|
my $datadir = $ENV{'AC_MACRODIR'} || '@datadir@';
|
|
my $autom4te_cfg = $ENV{'AUTOM4TE_CFG'} || "$datadir/autom4te.cfg";
|
|
|
|
# $LANGUAGE{$LANGUAGE} is the list of automatic options for $LANGUAGE.
|
|
my %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');
|
|
|
|
# Autom4te's default warnings, and the actual list of warnings.
|
|
my @my_warning = ('syntax');
|
|
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");
|
|
|
|
|
|
|
|
|
|
|
|
## ---------- ##
|
|
## Routines. ##
|
|
## ---------- ##
|
|
|
|
|
|
# $FILENAME
|
|
# find_file ($FILENAME)
|
|
# ---------------------
|
|
# We match exactly the behavior of GNU m4: first look in the current
|
|
# directory (which includes the case of absolute file names), and, if
|
|
# the file is not absolute, just fail. Otherwise, look in the path.
|
|
#
|
|
# If the file is flagged as optional (ends with `?'), then return undef
|
|
# if absent.
|
|
sub find_file ($)
|
|
{
|
|
my ($filename) = @_;
|
|
my $optional = 0;
|
|
|
|
$optional = 1
|
|
if $filename =~ s/\?$//;
|
|
|
|
return File::Spec->canonpath ($filename)
|
|
if -e $filename;
|
|
|
|
if (File::Spec->file_name_is_absolute ($filename))
|
|
{
|
|
die "$me: no such file or directory: $filename\n"
|
|
unless $optional;
|
|
return undef;
|
|
}
|
|
|
|
foreach my $path (@include)
|
|
{
|
|
return File::Spec->canonpath (File::Spec->catfile ($path, $filename))
|
|
if -e File::Spec->catfile ($path, $filename)
|
|
}
|
|
|
|
die "$me: no such file or directory: $filename\n"
|
|
unless $optional;
|
|
|
|
return undef;
|
|
}
|
|
|
|
|
|
# print_usage ()
|
|
# --------------
|
|
# Display usage (--help).
|
|
sub print_usage ()
|
|
{
|
|
# Quotes are backslahed to help Emacs' font-lock-mode.
|
|
print <<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
|
|
-s, --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. Several invocations accumulate
|
|
|
|
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
|
|
exit 0;
|
|
}
|
|
|
|
|
|
# print_version ()
|
|
# ----------------
|
|
# Display version (--version).
|
|
sub print_version
|
|
{
|
|
print <<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
|
|
|
|
exit 0;
|
|
}
|
|
|
|
|
|
# load_configuration ()
|
|
# ---------------------
|
|
# Load the configuration file.
|
|
sub load_configuration ()
|
|
{
|
|
use Text::ParseWords;
|
|
|
|
my $cfg = new IO::File ($autom4te_cfg)
|
|
or die "$me: cannot read $autom4te_cfg: $!\n";
|
|
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 ()
|
|
{
|
|
my @trace;
|
|
|
|
# We want to look for the early options, which should not be found
|
|
# in the configuration file. Prepend to the user arguments.
|
|
Getopt::Long::Configure ("bundling", "pass_through");
|
|
GetOptions (
|
|
"h|help" => \&print_usage,
|
|
"V|version" => \&print_version,
|
|
|
|
"s|language=s" => \$language,
|
|
"v|verbose" => \$verbose,
|
|
"d|debug" => \$debug,
|
|
)
|
|
or exit 1;
|
|
Getopt::Long::Configure ("defaults");
|
|
unshift @ARGV, @{$language{$language}}
|
|
if $language;
|
|
|
|
verbose "arguments: @ARGV\n"
|
|
if $debug;
|
|
|
|
# Process the arguments for real this time.
|
|
Getopt::Long::Configure ("bundling");
|
|
GetOptions
|
|
(
|
|
# 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,
|
|
)
|
|
or exit 1;
|
|
|
|
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.
|
|
@include = 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 ($_) } @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 (@my_warning,
|
|
split (',', ($ENV{'WARNINGS'} || '')),
|
|
map { split /,/ } @warning));
|
|
|
|
# GNU m4 appends when using --error-output.
|
|
unlink ($tcache . $req->id);
|
|
|
|
# Run m4.
|
|
my $command = ("$m4"
|
|
. " --define m4_warnings=$m4_warnings"
|
|
. ' --debug=aflq'
|
|
. " --error-output=$tcache" . $req->id
|
|
. join (' --trace=', '', sort @macro)
|
|
. join (' --include=', '', @include)
|
|
. $files
|
|
. " >$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 IO::File ("$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 IO::File 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 IO::File;
|
|
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 IO::File ($ocache . $req->id)
|
|
or die "$me: cannot read $ocache" . $req->id . ": $!\n";
|
|
|
|
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. Handling it last
|
|
# makes it possible to generate quadrigraphs, e.g. `@<@&t@:@'
|
|
# produces `@<:@'. In addition, it provides a means to
|
|
# explicitly allow some *occurrences* of forbidden patterns.
|
|
#
|
|
# The use of `@&t@' was suggested by Paul Eggert:
|
|
#
|
|
# ``I should give some credit to the @&t@ pun. The "&" is my
|
|
# own invention, but the "t" came from the source code of the
|
|
# ALGOL68C compiler, written by Steve Bourne (of Bourne shell
|
|
# fame), and which used "mt" to denote the empty string. In C,
|
|
# it would have looked like something like this:
|
|
#
|
|
# char const mt[] = "";
|
|
#
|
|
# but of course the source code was written in Algol 68.
|
|
#
|
|
# I don't know where he got "mt" from: it could have been his
|
|
# own invention, and I suppose it could have been a common pun
|
|
# around the Cambridge University computer lab at the time.''
|
|
$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 IO::File ($ARGV[$#ARGV])
|
|
or die "$me: cannot open $ARGV[$#ARGV]: $!\n";
|
|
$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 IO::File (">$tmp/traces.m4")
|
|
or die "$me: cannot create $tmp/traces.m4: $!\n";
|
|
|
|
$_ = <<'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 IO::File ($tcache . $req->id)
|
|
or die "$me: cannot open $tcache" . $req->id . ": $!\n";
|
|
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 IO::File ("$m4 $tmp/traces.m4 |")
|
|
or die "$me: cannot run $m4: $!\n";
|
|
my $out = new IO::File (">$output")
|
|
or die "$me: cannot run open $output: $!\n";
|
|
|
|
# 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_p ($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_p ($)
|
|
{
|
|
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 IO::File ("$tmp/dependencies");
|
|
push @dep, map { chomp; find_file ($_) } $deps->getlines;
|
|
|
|
# If $FILE is younger than one of its dependencies, it is outdated.
|
|
verbose "$file is the youngest cache file";
|
|
foreach (@dep)
|
|
{
|
|
verbose " dependency: $_";
|
|
if ($mtime < mtime ($_))
|
|
{
|
|
verbose "cache files are outdated: $_ is more recent";
|
|
return 0;
|
|
}
|
|
}
|
|
|
|
# Well, really, it's fine!
|
|
verbose "cache files are up to date";
|
|
return 1;
|
|
}
|
|
|
|
|
|
## -------------- ##
|
|
## 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_p ($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;
|