From: Akim Demaille Date: Sat, 2 Jun 2001 11:28:17 +0000 (+0000) Subject: * autom4te.in: New. X-Git-Tag: AUTOCONF-2.50a~72 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=4a8d7d11fbbe855fe0a70b41b4e3f67456ad0f60;p=thirdparty%2Fautoconf.git * autom4te.in: New. --- diff --git a/ChangeLog b/ChangeLog index 25ce5e584..8fbdb7ee0 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2001-06-02 Akim Demaille + + * autom4te.in: New. + 2001-06-02 Pavel Roskin * acgeneral.m4 (_AC_INIT_PREPARE): Don't rely on $? in the traps diff --git a/autom4te.in b/autom4te.in new file mode 100644 index 000000000..7abf31375 --- /dev/null +++ b/autom4te.in @@ -0,0 +1,955 @@ +#! @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. + +require 5.005; +use File::Basename; + +my $me = basename ($0); + +## --------- ## +## Request. ## +## --------- ## + +package Request; + +BEGIN +{ + my $prefix = "@prefix@"; + # FIXME: Import Struct into Autoconf. + my $perllibdir = $ENV{'perllibdir'} || "@datadir@/automake"; + unshift @INC, "$perllibdir"; +} + +use Data::Dumper; +use Automake::Struct; +use Carp; +use Getopt::Long; +use IO::File; +use strict; + +# List of requests +my @request; + +struct + ( + # The key of the cache file. + 'cache' => "\$", + # True if the cache file is up to date. + 'valid' => "\$", + # The include path. + 'path' => '@', + # The set of source files. + 'source' => '@', + # The set of included files. + 'includes' => '@', + # The set of macros currently traced. + 'macro' => '%', + ); + + +# Find a request with the same path and source. +sub retrieve +{ + my ($self, %attr) = @_; + + foreach (@request) + { + # Same path. + next + if join ("\n", @{$_->path}) ne join ("\n", @{$attr{path}}); + + # Same sources. + next + if join ("\n", @{$_->source}) ne join ("\n", @{$attr{source}}); + + # Found it. + return $_; + } + + return undef; +} + +# NEW should not be called directly. +sub register +{ + my ($self, %attr) = @_; + + # path and source are the only ID for a request object. + my $obj = $self->new ('path' => $attr{path}, + 'source' => $attr{source}); + push @request, $obj; + + # Assign a cache file. + $obj->cache ("traces.$#request"); + + return $obj; +} + + +# request(%REQUEST) +# ----------------- +# Return a request corresponding to $REQUEST{path} and $REQUEST{source}, +# using a cache value if it exists. +sub request +{ + my ($self, %request) = @_; + + my $obj = Request->retrieve (%request) || Request->register (%request); + + # If there are new traces to produce, then we are not valid. + foreach (@{$request{'macro'}}) + { + if (! exists ${$obj->macro}{$_}) + { + ${$obj->macro}{$_} = 1; + $obj->valid (0); + } + } + + return $obj; +} + +# 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"); + 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 ($FILENAME) +# ---------------- +sub load +{ + my ($self, $filename) = @_; + + croak "$me: cannot load a single request\n" + if ref ($self); + + do "$filename" + or croak "$me: cannot source $filename: $!\n"; +} + + +## ---------- ## +## Autom4te. ## +## ---------- ## + +package Autom4te; + +use Getopt::Long; +use File::Basename; +use IO::File; +use strict; + +# Our tmp dir. +my $tmp; + +# The macros we always trace. +my @required_trace = + ( + # We need `include' to find the dependencies. + 'include', + # These are wanted by autoheader. + 'AC_CONFIG_HEADERS', + 'AH_OUTPUT', + 'AC_DEFINE_TRACE_LITERAL', + # These will be traced by Automake. + 'AC_SUBST', + 'AC_LIBSOURCE', + ); + +# The macros to trace mapped to their format, as specified by the +# user. +my %trace; + +my $verbose = 0; +my $debug = 0; +my $output = '-'; +my @warning; + +my @include; + +# $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 &1 | fgrep reload-state >/dev/null"; + +# @M4_BUILTINS -- M4 builtins and a useful comment. +my @m4_builtins = `echo dumpdef | $m4 2>&1 >/dev/null`; +map { s/:.*//;s/\W// } @m4_builtins; + + +## ---------- ## +## Routines. ## +## ---------- ## + + +# mktmpdir ($SIGNATURE) +# --------------------- +# Create a temporary directory which name is based on $SIGNATURE. +sub mktmpdir ($) +{ + my ($signature) = @_; + my $TMPDIR = $ENV{'TMPDIR'} || '/tmp'; + + # If mktemp supports dirs, use it. + $tmp = `(umask 077 && + mktemp -d -q "$TMPDIR/${signature}XXXXXX") 2>/dev/null`; + + if (!$tmp || ! -d $tmp) + { + $tmp = "$TMPDIR/$signature" . int (rand 10000) . ".$$"; + mkdir $tmp, 0700 + or die "$me: cannot create $tmp: $!\n"; + } + + print STDERR "$me:$$: working in $tmp\n" + if $debug; +} + + +# verbose +# ------- +sub verbose (@) +{ + print STDERR "$me: ", @_, "\n" + if $verbose; +} + + +# END +# --- +# Exit nonzero whenever closing STDOUT fails. +sub END +{ + use POSIX qw (_exit); + + my ($q) = ($?); + + # FIXME: Heelp! Can't find a means to properly catch system's + # exit status (without hair I mean). + # my $status = $? >> 8; + + if (!$debug && defined $tmp && -d $tmp) + { + unlink <$tmp/*> + or warn ("$me: cannot empty $tmp: $!\n"), _exit (1); + rmdir $tmp + or warn ("$me: cannot remove $tmp: $!\n"), _exit (1); + } + + # This is required if the code might send any output to stdout + # E.g., even --version or --help. So it's best to do it unconditionally. + close STDOUT + or (warn "$me: closing standard output: $!\n"), _exit (1); + + ($!, $?) = (0, $q); +} + + +# xsystem ($COMMAND) +# ------------------ +sub xsystem ($) +{ + my ($command) = @_; + + verbose "running: $command"; + + (system $command) == 0 + or die ("$me: " + . (split (' ', $command))[0] + . " failed with exit status: $?\n"); +} + +# print_usage () +# -------------- +# Display usage (--help). +sub print_usage () +{ + print <. +EOF + # Help font-lock: ` + exit 0; +} + + +# print_version () +# ---------------- +# Display version (--version). +sub print_version +{ + print < \&print_usage, + "V|version" => \&print_version, + "v|verbose" => \$verbose, + "d|debug" => \$debug, + "o|output=s" => \$output, + "w|warnings=s" => \@warning, + + # 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, + ) + or exit 1; + + # Convert @trace to %trace. + # The default format is `$f:$l:$n:$*'. + foreach (@trace) + { + /^([^:]+)(?::(.*))?$/; + $trace{$1} = defined $2 ? $2 : '$f:$l:$n:$*'; + } + + die "$me: too few arguments +Try `$me --help' for more information.\n" + unless @ARGV; +} + + +# handle_m4 ($REQ, @TRACE) +# ------------------------ +# Run m4 on the input files, and save the traces on the @TRACE macros. +sub handle_m4 ($%) +{ + my ($req, @trace) = @_; + + # *.m4f files have to be reloaded. + my $files; + foreach (@ARGV) + { + $files .= ' '; + $files .= '--reload-state=' + if /\.m4f$/; + $files .= "$_"; + } + + # GNU m4 appends when using --error-output. + unlink ("$me.cache/" . $req->cache); + + # Run m4. + xsystem ("$m4" + . " --define m4_tmpdir=$tmp" + . " --define m4_warnings=" # FIXME: Pass the warnings. + . ' --debug=aflq' + . " --error-output=$me.cache/" . $req->cache + . join (' --trace=', '', @trace) + . join (' --include=', '', @include) + . $files + . " >$tmp/output"); +} + + +# handle_output ($OUTPUT) +# ----------------------- +# Run m4 on the input files, perform quadrigraphs substitution, check for +# forbidden tokens, and save into $OUTPUT. +sub handle_output ($) +{ + my ($output) = @_; + + verbose "creating $output"; + + # Load the forbidden/allowed patterns. + my $forbidden; + if (-f "$tmp/forbidden.rx") + { + my $fh = new IO::File ("$tmp/forbidden.rx"); + $forbidden = join ('|', grep { chop } $fh->getlines); + } + my $allowed = "^\$"; + if (-f "$tmp/allowed.rx") + { + my $fh = new IO::File ("$tmp/allowed.rx"); + $allowed = join ('|', grep { chop } $fh->getlines); + } + + my $out = new IO::File (">$output") + or die "$me: cannot open $output: $!\n"; + my $in = new IO::File ("$tmp/output") + or die "$me: cannot read $tmp/output: $!\n"; + + my $separate = 0; + my $oline = 0; + my %prohibited; + while ($_ = $in->getline) + { + s/\s+$//; + if (/^$/) + { + $separate = 1; + next; + } + + if ($separate) + { + $oline++; + print $out "\n"; + } + $separate = 0; + + $oline++; + s/__oline__/$oline/g; + s/\@<:\@/[/g; + s/\@:>\@/]/g; + s/\@\$\|\@/\$/g; + s/\@%:\@/#/g; + + print $out "$_\n"; + + foreach (split ('\W+')) + { + $prohibited{$_} = $oline + if /$forbidden/ && !/$allowed/; + } + } + + if (%prohibited) + { + my $prohibited = '\b(' . join ('|', keys %prohibited) . ')\b'; + my $in = new IO::File ($ARGV[$#ARGV]) + or die "$me: cannot open $ARGV[$#ARGV]: $!\n"; + + while ($_ = $in->getline) + { + if (/$prohibited/) + { + warn "$ARGV[$#ARGV]: $.: undefined macro: $1\n" + if exists $prohibited{$1}; + delete $prohibited{$1}; + } + } + foreach (keys %prohibited) + { + warn "$output: $prohibited{$_}: undefined macro: $_\n"; + } + } +} + + +## --------------------- ## +## Handling the traces. ## +## --------------------- ## + + +# %REQUEST +# trace_requests (%TRACE) +# ----------------------- +sub trace_requests +{ + my (%trace) = @_; + my %res; + + for my $macro (keys %trace) + { + $res{$macro} = 1; + $macro =~ s/^m4_//; + # See &handle_traces for an explanation for this paragraph. + if (grep /^$macro$/, @m4_builtins) + { + $res{$macro} = 1; + $res{"m4_$macro"} = 1; + } + } + + return %res; +} + + +# $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 %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; + } + } + + 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) = @_; + + # 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. + foreach my $macro (keys %trace) + { + my $format = $trace{$macro}; + $macro =~ s/^m4_//; + if (grep /^$macro$/, @m4_builtins) + { + $trace{$macro} = $format; + $trace{"m4_$macro"} = $format; + } + } + + verbose "formatting traces for `$output': ", join (', ', 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], ) + # + # Since `' 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_builtins; + print $trace_m4 "\n"; + + print $trace_m4 "# Disable them.\n"; + map { print $trace_m4 "at_undefine([$_])\n" } @m4_builtins; + 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 (keys %{$req->macro}); + print $trace_m4 "\n"; + + # Implement traces for current requests (%TRACE). + print $trace_m4 + "## ------------------------- ##\n", + "## Trace processing macros. ##\n", + "## ------------------------- ##\n", + "\n"; + foreach my $key (keys %trace) + { + print $trace_m4 "at_define([AT_$key],\n"; + print $trace_m4 trace_format_to_m4 ($trace{$key}) . ")\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 ("$me.cache/" . $req->cache) + or die "$me: cannot open $me.cache/" . $req->cache . ": $!\n"; + while ($_ = $traces->getline) + { + # Multiline traces. + s{^m4trace:(.+):(\d+): -(\d+)- ([^(]+)\((.*)$} + {AT_$4([$1], [$2], [$3], [$4], $5}; + # Single line traces, as the example above. + s{^m4trace:(.+):(\d+): -(\d+)- (.*)$} + {AT_$4([$1], [$2], [$3], [$4]}; + + 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"; + 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, $FILE) +# -------------------------- +# If $FILE up to date? +# We need $REQ since we check $FILE against all its dependencies, +# and we use the traces on `include' to find them. +sub up_to_date_p ($$) +{ + my ($req, $file) = @_; + + # If STDOUT or doesn't exist, it sure is outdated! + return 0 + if $file eq '-' || ! -f $file; + + # We can't answer properly if the traces are not computed since we + # need to know what other files were included. + return 0 + if ! -f "$me.cache/" . $req->cache; + + # 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')); + my $deps = new IO::File ("$tmp/dependencies"); + while ($_ = $deps->getline) + { + chop; + push @dep, $_; + } + + # If $FILE is younger than one of its dependencies, it is outdated. + my $mtime = (stat ($file))[9]; + foreach (@dep) + { + if ($mtime < (stat ($_))[9]) + { + verbose "$file depends on $_ which is more recent"; + return 0; + } + } + + # Well, really, it's fine! + return 1; +} + + +## -------------- ## +## Main program. ## +## -------------- ## + +parse_args; +mktmpdir ('t4'); + +# We need our cache directory. +if (! -d "$me.cache") + { + mkdir "$me.cache", 0755 + or die "$me: cannot create $me.cache: $!\n"; + } + +Request->load ("$me.cache/requests") + if -f "$me.cache/requests"; + +# Add the new trace requests. +my $req = Request->request ('source' => \@ARGV, + 'path' => \@include, + 'macro' => [keys %trace, @required_trace]); + +# We need to run M4 if +# - for traces +# + there is no cache, or +# + it does not include the traces we need, or +# + it exists but is outdated +# - for output if it is not /dev/null and +# + it doesn't exist, or +# + it is outdated +handle_m4 ($req, keys %{$req->macro}) + if (! $req->valid + || ! up_to_date_p ($req, "$me.cache/" . $req->cache) + || (! %trace && ! up_to_date_p ($req, "$output"))); + +if (%trace) + { + # Producing traces. + # Trying to produce the output only when needed is very + # error prone here, as you'd have to check that the trace + # requests have not changed etc. + handle_traces ($req, $output, %trace); + } +else + { + # Actual M4 expansion. + handle_output ($output) + if ! up_to_date_p ($req, $output); + } + +# All went fine, the cache is valid. +$req->valid (1); + +Request->save ("$me.cache/requests"); + +exit 0; diff --git a/bin/autom4te.in b/bin/autom4te.in new file mode 100644 index 000000000..7abf31375 --- /dev/null +++ b/bin/autom4te.in @@ -0,0 +1,955 @@ +#! @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. + +require 5.005; +use File::Basename; + +my $me = basename ($0); + +## --------- ## +## Request. ## +## --------- ## + +package Request; + +BEGIN +{ + my $prefix = "@prefix@"; + # FIXME: Import Struct into Autoconf. + my $perllibdir = $ENV{'perllibdir'} || "@datadir@/automake"; + unshift @INC, "$perllibdir"; +} + +use Data::Dumper; +use Automake::Struct; +use Carp; +use Getopt::Long; +use IO::File; +use strict; + +# List of requests +my @request; + +struct + ( + # The key of the cache file. + 'cache' => "\$", + # True if the cache file is up to date. + 'valid' => "\$", + # The include path. + 'path' => '@', + # The set of source files. + 'source' => '@', + # The set of included files. + 'includes' => '@', + # The set of macros currently traced. + 'macro' => '%', + ); + + +# Find a request with the same path and source. +sub retrieve +{ + my ($self, %attr) = @_; + + foreach (@request) + { + # Same path. + next + if join ("\n", @{$_->path}) ne join ("\n", @{$attr{path}}); + + # Same sources. + next + if join ("\n", @{$_->source}) ne join ("\n", @{$attr{source}}); + + # Found it. + return $_; + } + + return undef; +} + +# NEW should not be called directly. +sub register +{ + my ($self, %attr) = @_; + + # path and source are the only ID for a request object. + my $obj = $self->new ('path' => $attr{path}, + 'source' => $attr{source}); + push @request, $obj; + + # Assign a cache file. + $obj->cache ("traces.$#request"); + + return $obj; +} + + +# request(%REQUEST) +# ----------------- +# Return a request corresponding to $REQUEST{path} and $REQUEST{source}, +# using a cache value if it exists. +sub request +{ + my ($self, %request) = @_; + + my $obj = Request->retrieve (%request) || Request->register (%request); + + # If there are new traces to produce, then we are not valid. + foreach (@{$request{'macro'}}) + { + if (! exists ${$obj->macro}{$_}) + { + ${$obj->macro}{$_} = 1; + $obj->valid (0); + } + } + + return $obj; +} + +# 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"); + 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 ($FILENAME) +# ---------------- +sub load +{ + my ($self, $filename) = @_; + + croak "$me: cannot load a single request\n" + if ref ($self); + + do "$filename" + or croak "$me: cannot source $filename: $!\n"; +} + + +## ---------- ## +## Autom4te. ## +## ---------- ## + +package Autom4te; + +use Getopt::Long; +use File::Basename; +use IO::File; +use strict; + +# Our tmp dir. +my $tmp; + +# The macros we always trace. +my @required_trace = + ( + # We need `include' to find the dependencies. + 'include', + # These are wanted by autoheader. + 'AC_CONFIG_HEADERS', + 'AH_OUTPUT', + 'AC_DEFINE_TRACE_LITERAL', + # These will be traced by Automake. + 'AC_SUBST', + 'AC_LIBSOURCE', + ); + +# The macros to trace mapped to their format, as specified by the +# user. +my %trace; + +my $verbose = 0; +my $debug = 0; +my $output = '-'; +my @warning; + +my @include; + +# $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 &1 | fgrep reload-state >/dev/null"; + +# @M4_BUILTINS -- M4 builtins and a useful comment. +my @m4_builtins = `echo dumpdef | $m4 2>&1 >/dev/null`; +map { s/:.*//;s/\W// } @m4_builtins; + + +## ---------- ## +## Routines. ## +## ---------- ## + + +# mktmpdir ($SIGNATURE) +# --------------------- +# Create a temporary directory which name is based on $SIGNATURE. +sub mktmpdir ($) +{ + my ($signature) = @_; + my $TMPDIR = $ENV{'TMPDIR'} || '/tmp'; + + # If mktemp supports dirs, use it. + $tmp = `(umask 077 && + mktemp -d -q "$TMPDIR/${signature}XXXXXX") 2>/dev/null`; + + if (!$tmp || ! -d $tmp) + { + $tmp = "$TMPDIR/$signature" . int (rand 10000) . ".$$"; + mkdir $tmp, 0700 + or die "$me: cannot create $tmp: $!\n"; + } + + print STDERR "$me:$$: working in $tmp\n" + if $debug; +} + + +# verbose +# ------- +sub verbose (@) +{ + print STDERR "$me: ", @_, "\n" + if $verbose; +} + + +# END +# --- +# Exit nonzero whenever closing STDOUT fails. +sub END +{ + use POSIX qw (_exit); + + my ($q) = ($?); + + # FIXME: Heelp! Can't find a means to properly catch system's + # exit status (without hair I mean). + # my $status = $? >> 8; + + if (!$debug && defined $tmp && -d $tmp) + { + unlink <$tmp/*> + or warn ("$me: cannot empty $tmp: $!\n"), _exit (1); + rmdir $tmp + or warn ("$me: cannot remove $tmp: $!\n"), _exit (1); + } + + # This is required if the code might send any output to stdout + # E.g., even --version or --help. So it's best to do it unconditionally. + close STDOUT + or (warn "$me: closing standard output: $!\n"), _exit (1); + + ($!, $?) = (0, $q); +} + + +# xsystem ($COMMAND) +# ------------------ +sub xsystem ($) +{ + my ($command) = @_; + + verbose "running: $command"; + + (system $command) == 0 + or die ("$me: " + . (split (' ', $command))[0] + . " failed with exit status: $?\n"); +} + +# print_usage () +# -------------- +# Display usage (--help). +sub print_usage () +{ + print <. +EOF + # Help font-lock: ` + exit 0; +} + + +# print_version () +# ---------------- +# Display version (--version). +sub print_version +{ + print < \&print_usage, + "V|version" => \&print_version, + "v|verbose" => \$verbose, + "d|debug" => \$debug, + "o|output=s" => \$output, + "w|warnings=s" => \@warning, + + # 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, + ) + or exit 1; + + # Convert @trace to %trace. + # The default format is `$f:$l:$n:$*'. + foreach (@trace) + { + /^([^:]+)(?::(.*))?$/; + $trace{$1} = defined $2 ? $2 : '$f:$l:$n:$*'; + } + + die "$me: too few arguments +Try `$me --help' for more information.\n" + unless @ARGV; +} + + +# handle_m4 ($REQ, @TRACE) +# ------------------------ +# Run m4 on the input files, and save the traces on the @TRACE macros. +sub handle_m4 ($%) +{ + my ($req, @trace) = @_; + + # *.m4f files have to be reloaded. + my $files; + foreach (@ARGV) + { + $files .= ' '; + $files .= '--reload-state=' + if /\.m4f$/; + $files .= "$_"; + } + + # GNU m4 appends when using --error-output. + unlink ("$me.cache/" . $req->cache); + + # Run m4. + xsystem ("$m4" + . " --define m4_tmpdir=$tmp" + . " --define m4_warnings=" # FIXME: Pass the warnings. + . ' --debug=aflq' + . " --error-output=$me.cache/" . $req->cache + . join (' --trace=', '', @trace) + . join (' --include=', '', @include) + . $files + . " >$tmp/output"); +} + + +# handle_output ($OUTPUT) +# ----------------------- +# Run m4 on the input files, perform quadrigraphs substitution, check for +# forbidden tokens, and save into $OUTPUT. +sub handle_output ($) +{ + my ($output) = @_; + + verbose "creating $output"; + + # Load the forbidden/allowed patterns. + my $forbidden; + if (-f "$tmp/forbidden.rx") + { + my $fh = new IO::File ("$tmp/forbidden.rx"); + $forbidden = join ('|', grep { chop } $fh->getlines); + } + my $allowed = "^\$"; + if (-f "$tmp/allowed.rx") + { + my $fh = new IO::File ("$tmp/allowed.rx"); + $allowed = join ('|', grep { chop } $fh->getlines); + } + + my $out = new IO::File (">$output") + or die "$me: cannot open $output: $!\n"; + my $in = new IO::File ("$tmp/output") + or die "$me: cannot read $tmp/output: $!\n"; + + my $separate = 0; + my $oline = 0; + my %prohibited; + while ($_ = $in->getline) + { + s/\s+$//; + if (/^$/) + { + $separate = 1; + next; + } + + if ($separate) + { + $oline++; + print $out "\n"; + } + $separate = 0; + + $oline++; + s/__oline__/$oline/g; + s/\@<:\@/[/g; + s/\@:>\@/]/g; + s/\@\$\|\@/\$/g; + s/\@%:\@/#/g; + + print $out "$_\n"; + + foreach (split ('\W+')) + { + $prohibited{$_} = $oline + if /$forbidden/ && !/$allowed/; + } + } + + if (%prohibited) + { + my $prohibited = '\b(' . join ('|', keys %prohibited) . ')\b'; + my $in = new IO::File ($ARGV[$#ARGV]) + or die "$me: cannot open $ARGV[$#ARGV]: $!\n"; + + while ($_ = $in->getline) + { + if (/$prohibited/) + { + warn "$ARGV[$#ARGV]: $.: undefined macro: $1\n" + if exists $prohibited{$1}; + delete $prohibited{$1}; + } + } + foreach (keys %prohibited) + { + warn "$output: $prohibited{$_}: undefined macro: $_\n"; + } + } +} + + +## --------------------- ## +## Handling the traces. ## +## --------------------- ## + + +# %REQUEST +# trace_requests (%TRACE) +# ----------------------- +sub trace_requests +{ + my (%trace) = @_; + my %res; + + for my $macro (keys %trace) + { + $res{$macro} = 1; + $macro =~ s/^m4_//; + # See &handle_traces for an explanation for this paragraph. + if (grep /^$macro$/, @m4_builtins) + { + $res{$macro} = 1; + $res{"m4_$macro"} = 1; + } + } + + return %res; +} + + +# $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 %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; + } + } + + 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) = @_; + + # 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. + foreach my $macro (keys %trace) + { + my $format = $trace{$macro}; + $macro =~ s/^m4_//; + if (grep /^$macro$/, @m4_builtins) + { + $trace{$macro} = $format; + $trace{"m4_$macro"} = $format; + } + } + + verbose "formatting traces for `$output': ", join (', ', 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], ) + # + # Since `' 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_builtins; + print $trace_m4 "\n"; + + print $trace_m4 "# Disable them.\n"; + map { print $trace_m4 "at_undefine([$_])\n" } @m4_builtins; + 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 (keys %{$req->macro}); + print $trace_m4 "\n"; + + # Implement traces for current requests (%TRACE). + print $trace_m4 + "## ------------------------- ##\n", + "## Trace processing macros. ##\n", + "## ------------------------- ##\n", + "\n"; + foreach my $key (keys %trace) + { + print $trace_m4 "at_define([AT_$key],\n"; + print $trace_m4 trace_format_to_m4 ($trace{$key}) . ")\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 ("$me.cache/" . $req->cache) + or die "$me: cannot open $me.cache/" . $req->cache . ": $!\n"; + while ($_ = $traces->getline) + { + # Multiline traces. + s{^m4trace:(.+):(\d+): -(\d+)- ([^(]+)\((.*)$} + {AT_$4([$1], [$2], [$3], [$4], $5}; + # Single line traces, as the example above. + s{^m4trace:(.+):(\d+): -(\d+)- (.*)$} + {AT_$4([$1], [$2], [$3], [$4]}; + + 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"; + 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, $FILE) +# -------------------------- +# If $FILE up to date? +# We need $REQ since we check $FILE against all its dependencies, +# and we use the traces on `include' to find them. +sub up_to_date_p ($$) +{ + my ($req, $file) = @_; + + # If STDOUT or doesn't exist, it sure is outdated! + return 0 + if $file eq '-' || ! -f $file; + + # We can't answer properly if the traces are not computed since we + # need to know what other files were included. + return 0 + if ! -f "$me.cache/" . $req->cache; + + # 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')); + my $deps = new IO::File ("$tmp/dependencies"); + while ($_ = $deps->getline) + { + chop; + push @dep, $_; + } + + # If $FILE is younger than one of its dependencies, it is outdated. + my $mtime = (stat ($file))[9]; + foreach (@dep) + { + if ($mtime < (stat ($_))[9]) + { + verbose "$file depends on $_ which is more recent"; + return 0; + } + } + + # Well, really, it's fine! + return 1; +} + + +## -------------- ## +## Main program. ## +## -------------- ## + +parse_args; +mktmpdir ('t4'); + +# We need our cache directory. +if (! -d "$me.cache") + { + mkdir "$me.cache", 0755 + or die "$me: cannot create $me.cache: $!\n"; + } + +Request->load ("$me.cache/requests") + if -f "$me.cache/requests"; + +# Add the new trace requests. +my $req = Request->request ('source' => \@ARGV, + 'path' => \@include, + 'macro' => [keys %trace, @required_trace]); + +# We need to run M4 if +# - for traces +# + there is no cache, or +# + it does not include the traces we need, or +# + it exists but is outdated +# - for output if it is not /dev/null and +# + it doesn't exist, or +# + it is outdated +handle_m4 ($req, keys %{$req->macro}) + if (! $req->valid + || ! up_to_date_p ($req, "$me.cache/" . $req->cache) + || (! %trace && ! up_to_date_p ($req, "$output"))); + +if (%trace) + { + # Producing traces. + # Trying to produce the output only when needed is very + # error prone here, as you'd have to check that the trace + # requests have not changed etc. + handle_traces ($req, $output, %trace); + } +else + { + # Actual M4 expansion. + handle_output ($output) + if ! up_to_date_p ($req, $output); + } + +# All went fine, the cache is valid. +$req->valid (1); + +Request->save ("$me.cache/requests"); + +exit 0; diff --git a/man/autoconf.1 b/man/autoconf.1 index fd7616f3b..76709a93f 100644 --- a/man/autoconf.1 +++ b/man/autoconf.1 @@ -1,5 +1,5 @@ .\" DO NOT MODIFY THIS FILE! It was generated by help2man 1.24. -.TH AUTOCONF "1" "May 2001" "GNU Autoconf 2.50a" FSF +.TH AUTOCONF "1" "June 2001" "GNU Autoconf 2.50a" FSF .SH NAME autoconf \- Generate configuration scripts .SH SYNOPSIS