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