autom4te.in 31 KB

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