autom4te.in

autoconf 2.59版,可用于redhat系统.用于编译原码,编写makefile文件.

    map { /^forbid:([^:]+):.+$/ => /^forbid:[^:]+:(.+)$/ } @patterns;
  my $forbidden = join ('|', map { /^forbid:([^:]+)/ } @patterns) || "^\$";
  my $allowed   = join ('|', map { /^allow:([^:]+)/  } @patterns) || "^\$";

  verb "forbidden tokens: $forbidden";
  verb "forbidden token : $_ => $forbidden{$_}"
    foreach (sort keys %forbidden);
  verb "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));
    }
  fatal "cannot create $output: $!"
    unless $out;
  my $in = new Autom4te::XFile ($ocache . $req->id);

  my %prohibited;
  my $res;
  while ($_ = $in->getline)
    {
      s/\s+$//;
      s/__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{$_} = $.
	    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_code = 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/)
	{
	  my $word = $1;
	  warn_forbidden ("$ARGV[$#ARGV]:$.", $word, %forbidden);
	  delete $prohibited{$word};
	  # If we're done, exit.
	  return
	    if ! %prohibited;
	  $prohibited = '\b(' . join ('|', keys %prohibited) . ')\b';
	}
    }
  warn_forbidden ("$output:$prohibited{$_}", $_, %forbidden)
    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 (/^(\$.)/)
	{
	  error "invalid escape: $1";
	}
      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) = @_;

  verb "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(at_patsubst([[[[$1]]]], [\\\n]),
				       [[\n\t ]+], [ ]),
			   [ *\(.\)$], [\1]),
	       [^ *\(.*\)], [[\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");

  # This is dubious: should we really transform the quadrigraphs in
  # traces?  It might break balanced [ ] etc. in the output.  The
  # consensus seeems to be that traces are more useful this way.
  while ($_ = $in->getline)
    {
      # It makes no sense to try to transform __oline__.
      s/\@<:\@/[/g;
      s/\@:>\@/]/g;
      s/\@\$\|\@/\$/g;
      s/\@%:\@/#/g;
      s/\@&t\@//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");
  while ($_ = $deps->getline)
    {
      chomp;
      my $file = find_file ("$_?", @include);
      # If a file which used to be included is no longer there, then
      # don't say it's missing (it might no longer be included).  But
      # of course, that cause the output to be outdated (as if the
      # time stamp of that missing file was newer).
      return 0
	if ! $file;
      push @dep, $file;
    }

  # If $FILE is younger than one of its dependencies, it is outdated.
  return up_to_date_p ($file, @dep);
}


## ---------- ##
## Freezing.  ##
## ---------- ##

# freeze ($OUTPUT)
# ----------------
sub freeze ($)
{
  my ($output) = @_;

  # When processing the file with diversion disabled, there must be no
  # output but comments and empty lines.
  my $result = xqx ("$m4"
		    . ' --fatal-warning'
		    . join (' --include=', '', @include)
		    . ' --define=divert'
		    . " " . files_to_options (@ARGV)
		    . ' </dev/null');
  $result =~ s/#.*\n//g;
  $result =~ s/^\n//mg;

  fatal "freezing produced output:\n$result"
    if $result;

  # If freezing produces output, something went wrong: a bad `divert',
  # or an improper paren etc.
  xsystem ("$m4"
	   . ' --fatal-warning'
	   . join (' --include=', '', @include)
	   . " --freeze-state=$output"
	   . " " . files_to_options (@ARGV)
	   . ' </dev/null');
}

## -------------- ##
## Main program.  ##
## -------------- ##

mktmpdir ('am4t');
load_configuration ($ENV{'AUTOM4TE_CFG'} || "$datadir/autom4te.cfg");
load_configuration ("$ENV{'HOME'}/.autom4te.cfg")
  if exists $ENV{'HOME'} && -f "$ENV{'HOME'}/.autom4te.cfg";
load_configuration (".autom4te.cfg")
  if -f ".autom4te.cfg";
parse_args;

# Freezing does not involve the cache.
if ($freeze)
  {
    freeze ($output);
    exit $exit_code;
  }

# We need our cache directory.
if (! -d "$cache")
  {
    mkdir "$cache", 0755
      or fatal "cannot create $cache: $!";
  }

# Open the index for update, and lock it.  autom4te handles several
# files, but the index is the first and last file to be update, so
# locking it is sufficient.
$icache_file = new Autom4te::XFile $icache, O_RDWR|O_CREAT;
$icache_file->lock (LOCK_EX);

# Read the cache index if available and older than autom4te itself.
# If autom4te is younger, then some structures such as C4che, might
# have changed, which would corrupt its processing.
Autom4te::C4che->load ($icache_file)
  if -f $icache && mtime ($icache) > mtime ($0);

# Add the new trace requests.
my $req = Autom4te::C4che->request ('input' => \@ARGV,
				    'path'  => \@include,
				    'macro' => [keys %trace, @preselect]);

# If $REQ's cache files are not up to date, or simply if the user
# discarded them (-f), declare it invalid.
$req->valid (0)
  if $force || ! up_to_date ($req);

# We now know whether we can trust the Request object.  Say it.
verb "the trace request object is:\n" . $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;

# Issue the warnings each time autom4te was run.
my $separator = "\n" . ('-' x 25) . " END OF WARNING " . ('-' x 25) . "\n\n";
handle_traces ($req, "$tmp/warnings",
	       ('_m4_warn' => "\$1::\$f:\$l::\$2::\$3$separator"));
# Swallow excessive newlines.
for (split (/\n*$separator\n*/o, contents ("$tmp/warnings")))
{
  # The message looks like:
  # | syntax::input.as:5::ouch
  # | ::input.as:4: baz is expanded from...
  # | input.as:2: bar is expanded from...
  # | input.as:3: foo is expanded from...
  # | input.as:5: the top level
  my ($cat, $loc, $msg, $stacktrace) = split ('::', $_, 4);
  msg $cat, $loc, "warning: $msg";
  for (split /\n/, $stacktrace)
    {
      my ($loc, $trace) = split (': ', $_, 2);
      msg $cat, $loc, $trace;
    }
}

# 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 formatting
    # 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 we ran up to here, the cache is valid.
$req->valid (1);
Autom4te::C4che->save ($icache_file);

exit $exit_code;

### Setup "GNU" style for perl-mode and cperl-mode.
## Local Variables:
## perl-indent-level: 2
## perl-continued-statement-offset: 2
## perl-continued-brace-offset: 0
## perl-brace-offset: 0
## perl-brace-imaginary-offset: 0
## perl-label-offset: -2
## cperl-indent-level: 2
## cperl-brace-offset: 0
## cperl-continued-brace-offset: 0
## cperl-label-offset: -2
## cperl-extra-newline-before-brace: t
## cperl-merge-trailing-else: nil
## cperl-continued-statement-offset: 2
## End: