-# Extract all examples from the manual source. -*- AWK -*-
+#! /usr/bin/perl -w
+# Extract all examples from the manual source.
# This file is part of GNU Bison
-# Copyright (C) 1992, 2000-2001, 2005-2006, 2009-2012 Free Software
+# Copyright (C) 1992, 2000-2001, 2005-2006, 2009-2013 Free Software
# Foundation, Inc.
#
# This program is free software: you can redistribute it and/or modify
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
-# This script is for use with any Awk that conforms to POSIX.
-# It was derived from a similar script tests/generate.awk in GNU m4.
-#
# Usage: extexi input-file.texi ... -- [FILES to extract]
-BEGIN {
- if (!output_dir)
- output_dir = ".";
- for (argc = 1; argc < ARGC; ++argc)
- if (ARGV[argc] == "--")
- break;
- for (i = argc + 1; i < ARGC; ++i)
- file_wanted[ARGV[i]] = 1;
- ARGC = argc;
-}
-
-/^@node / {
- if (seq > 0)
- print "AT_CLEANUP";
- split ($0, tmp, ",");
- node = substr(tmp[1], 7);
- seq = 0;
+# Look for @example environments preceded with lines such as:
+#
+# @comment file calc.y
+# or
+# @comment file calc.y: 3
+#
+# and output their content in that file (calc.y). When numbers are
+# provided, use them to decide the output order (block numbered 1 is
+# output before block 2, even if the latter appears before). The same
+# number may be used several time, in which case the order of
+# appearance is used.
+
+use strict;
+
+# normalize($block)
+# -----------------
+# Remove Texinfo mark up.
+sub normalize($)
+{
+ local ($_) = @_;
+
+ s/^\@(c |comment|dots|end (ignore|group)|ignore|group).*//mg;
+ s/\@value\{VERSION\}/$ENV{VERSION}/g;
+ s/^\@(error|result)\{\}//mg;
+ s/\@([{}@])/$1/g;
+ s/\@comment.*//;
+ $_;
}
-/^@comment file: / {
- if (!file_wanted[$3])
- message("ignoring " $3);
- else
+# Print messages only once.
+my %msg;
+sub message($)
+{
+ my ($msg) = @_;
+ if (! $msg{$msg})
{
- message("extracting " $3);
- file = $3;
+ print STDERR "extexi: $msg\n";
+ $msg{$msg} = 1;
}
}
-/^@(small)?example$/, /^@end (small)?example$/ {
- if (!file)
- next;
-
- if ($0 ~ /^@(small)?example$/)
+# basename => full file name for files we should extract.
+my %file_wanted;
+
+sub process ($)
+{
+ my ($in) = @_;
+ use IO::File;
+ my $f = new IO::File($in)
+ or die "$in: cannot open: $?";
+ # FILE-NAME => { BLOCK-NUM => CODE }
+ my %file;
+
+ # The latest "@comment file: FILE [BLOCK-NUM]" arguments.
+ my $file;
+ my $block;
+ # The @example block currently read.
+ my $input;
+ local $_;
+ while (<$f>)
{
- input = files_output[file] ? "\n" : "";
-
- # FNR is starting at 0 instead of 1, and
- # #line report the line number of the *next* line.
- # => + 2.
- # Note that recent Bison support it, but not Flex.
- if (file ~ /\.[chy]*$/)
- input = "#line " (FNR + 1) " \"" FILENAME "\"\n";
- next;
+ if (/^\@comment file: ([^:\n]+)(?::\s*(\d+))?$/)
+ {
+ my $f = $1;
+ $block = $2 || 1;
+ if ($file_wanted{$f})
+ {
+ $file = $file_wanted{$f};
+ message(" GEN $file");
+ }
+ else
+ {
+ message("SKIP $f");
+ }
+ }
+ elsif ($file && /^\@(small)?example$/ .. /^\@end (small)?example$/)
+ {
+ if (/^\@(small)?example$/)
+ {
+ # Bison supports synclines, but not Flex.
+ $input .= sprintf ("#line %s \"$in\"\n", $. + 1)
+ if $file =~ /\.[chy]*$/;
+ next;
+ }
+ elsif (/^\@end (small)?example$/)
+ {
+ die "no contents: $file"
+ if $input eq "";
+
+ $file{$file}{$block} .= normalize($input);
+ $file = $input = undef;
+ ++$block;
+ }
+ else
+ {
+ $input .= $_;
+ }
+ }
}
- if ($0 ~ /^@end (small)?example$/)
+ # Output the files.
+ for my $file (keys %file)
{
- if (input == "")
- fatal("no contents: " file);
-
- input = normalize(input);
# No spurious end of line: use printf.
- if (files_output[file])
- # The parens around the output file seem to be required
- # by awk on Mac OS X Tiger (darwin 8.4.6).
- printf ("%s", input) >> (output_dir "/" file);
- else
- printf ("%s", input) > (output_dir "/" file);
- close (output_dir "/" file);
- files_output[file] = 1;
-
- file = input = "";
- next;
+ my $o = new IO::File(">$file")
+ or die "$file: cannot create: $?";
+ print $o $file{$file}{$_}
+ for sort keys %{$file{$file}};
}
-
- input = input $0 "\n";
}
-
-# We have to handle CONTENTS line per line, since anchors in AWK are
-# referring to the whole string, not the lines.
-function normalize(contents, i, lines, n, line, res) {
- # Remove the Texinfo tags.
- n = split (contents, lines, "\n");
- # We don't want the last field which empty: it's behind the last \n.
- for (i = 1; i < n; ++i)
+my @input;
+my $seen_dash = 0;
+for my $arg (@ARGV)
+{
+ if ($arg eq '--')
{
- line = lines[i];
-
- # Whole line commands.
- if (line ~ /^@(c |comment|dots|end (ignore|group)|ignore|group)/)
- # Gperf accepts empty lines as valid input!!!
- if (file ~ /\.gperf$/)
- continue;
- else
- line = "";
-
- gsub (/"@value\{VERSION\}"/, "\"" VERSION "\"", line)
- gsub (/^@result\{\}/, "", line);
- gsub (/^@error\{\}/, "", line);
- gsub ("@[{]", "{", line);
- gsub ("@}", "}", line);
- gsub ("@@", "@", line);
- gsub ("@comment.*", "", line);
-
- res = res line "\n";
+ $seen_dash = 1;
}
- return res;
-}
-
-
-function message(msg) {
- if (! message_printed[msg])
+ elsif ($seen_dash)
{
- print "extexi: " msg > "/dev/stderr";
- message_printed[msg] = 1;
+ use File::Basename;
+ $file_wanted{basename($arg)} = $arg;
+ }
+ else
+ {
+ push @input, $arg;
}
}
-
-function fatal(msg) {
- message(msg);
- exit 1
-}
+process $_
+ foreach @input;
+
+
+### 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:
projects / bison.git / blobdiff