chiark / gitweb /
README: Refer to example/
[subdirmk.git] / tests / filter / extract-doctests
1 #!/usr/bin/perl -w
2 #
3 # script for extracting doctests from README
4 #
5 # usage:
6 #   expand <README | tests/filter/extract-doctests tests/filter/
7 # writes:
8 #   tests/filter/doctests.mk.part
9 #   tests/filter/sub/dir/doctests.mk.part
10 #
11 # Relies on some properties of the way README is laid out.
12 # See comments below marked `parse:' and `adhoc:'.
13
14 use strict;
15 use Carp;
16 use Data::Dumper;
17
18 our @exp;
19 # $exp[]{In}
20 # $exp[]{Out}
21 # $exp[]{OutTop}
22
23 my $cent;
24 my $in_changequote;
25 my $lastl;
26 my $csection;
27 my $withspcs = qr{\S+(?: \S+)*};
28
29 my $outdir = shift @ARGV // confess;
30
31 while (<>) {
32     # adhoc: rely on structure of indented examples in &:changequote part
33     $in_changequote = (m{^\&\:changequote}...m{^\S}) && m{^\s};
34     if (m{^-----|^- - - - -}) {
35         # parse: rely on underlines for (sub)section headings
36         $csection = $lastl;
37         next;
38     }
39     $lastl = $_;
40     my $e = { L => $. };
41     # parse: rely on looking for => (and .. on subsequent lines)
42     next unless m{\=\>} or ($cent and m{ \.\. });
43     my $mapop = '=>';
44     # adhoc: special case NEWQUOTE here so we recognise things in changequote
45     if (s{^(\s*)(\&\S+|NEWQUOTE\S+|\$)\s+(\=\>|\.\.)\s+(\S+)\s+}{} ||
46         s{^()(\&\:\w+(?: \S+)*)\s{2,}(\=\>)\s{2,}($withspcs)$}{} ||
47         $cent && s{^()($withspcs)\s{2,}(\.\.)\s{2,}($withspcs)$}{}) {
48         # adhoc: expected indented iff in changequote part
49         confess if length($1) xor $in_changequote;
50         $mapop = $3;
51         confess if !$cent && $mapop ne '=>';
52         $e->{In} = $2;
53         $e->{Out} = $4;
54         if (# adhoc: `or ...' introduces the `at toplevel' expansion
55             s{^or (\S+)$}{}) {
56             $e->{OutTop} = $1 eq 'nothing' ? '' : $1;
57         } elsif (# parse: expect other wordish things to be comments
58                  m{^(?!or\b)\w{2,} }) {
59         } elsif (# adhoc: slightly special case for $(eval $(call
60                  m{^\$\{.*}) {
61             $e->{Out} .= ' '.$&;
62         } elsif (m/^$/) {
63         } else {
64             confess "unk rhs $_ ?";
65         }
66         $e->{CQ} = $in_changequote;
67         # adhoc: rely on this specific section title
68         $e->{DD} = $csection =~ m{^while dollar[- ]doubling}i;
69     } else {
70         confess "$_ ?";
71     }
72     if ($mapop eq '=>') {
73         if ($e->{In} =~ m/\bNN\b/) {
74             # adhoc: special case NN in examples
75             confess if defined $cent->{OutTop};
76             foreach my $nn (0..11, 999) {
77                 my $f = { %$e };
78                 foreach my $k (qw(In Out)) {
79                     $f->{$k} = $e->{$k};
80                     ($f->{$k} =~ s/\bNN\b/$nn/g) == 1 or confess;
81                 }
82                 push @exp, $f;
83             }
84             $cent=undef;
85         } else {
86             push @exp, $e;
87             $cent=$e;
88         }
89     } elsif ($mapop eq '..') {
90         confess if defined $cent->{OutTop};
91         foreach my $k (qw(In Out)) {
92             $cent->{$k} .= "\n".$e->{$k};
93         }
94     }
95 }
96
97 print Dumper(\@exp);
98
99 sub oi { print I @_ or die $!; }
100 sub oo { print O @_ or die $!; }
101 sub oh { oi @_; oo @_; }
102
103 sub write_permode ($$$$$;$$) {
104     my ($dir_prefix, $start, $end, $senl, $what,
105         $filter, $omap) = @_;
106     $filter //= sub { 1 };
107     $omap //= sub { $_[0] };
108     oi $start;
109     oh "${senl}# ----- $what starts -----\n";
110     foreach my $e (@exp) {
111         next unless $filter->($e);
112         my $desc = $e->{In};
113         $desc =~ s/\&/AMP /g;
114         $desc =~ s/\$/DOLLAR /g;
115         $desc =~ s/NEWQUOTE/NEW_QUOTE /g;
116         my ($f,$pdesc) = $desc =~ m/^(.*)\n/
117                 ? ("\n# %s:\n%s\n\n", $1)
118                 : ("%-30s: %s .\n", $desc);
119         my $o;
120         $o = $e->{OutTop} if $dir_prefix eq '';
121         $o //= $e->{Out};
122         $o =~ s{/sub/dir}{} if $dir_prefix eq '' && !defined $e->{OutTop};
123         $o = $omap->($o, $e);
124         oi sprintf $f, $pdesc, $e->{In};
125         oo sprintf $f, $pdesc, $o;
126     }
127     oi $end;
128     oh "${senl}# ----- $what ends -----\n";
129 }
130     
131 sub writeout ($) {
132     my ($dir_prefix) = @_;
133     open I, '>', "$outdir/${dir_prefix}doctests.sd.mk" or die $!;
134     open O, '>', "$outdir/${dir_prefix}doctests.mk.part" or die $!;
135     oh "# doctests start $dir_prefix\n";
136     write_permode($dir_prefix,
137                   '','','', 'normal',
138                  sub { !$_[0]{DD} && !$_[0]{CQ} } );
139     write_permode($dir_prefix,
140                   '&$+', '&$-', "\n",
141                   'dollar doubling',
142                   sub {
143                       my ($e) = @_;
144                       # adhoc: skip &:macro in already-doubling part
145                       return 0 if $e->{In} =~ m{^\&\:macro};
146                       # adhoc: skip &${ ie eval in already-doubling part
147                       return 0 if $e->{In} =~ m{^\&\$\{};
148                       return 0 if $e->{CQ};
149                       return $e->{DD} || !grep {
150                           # If there are two entries with the same In,
151                           # use only the one from the `while dollar
152                           # doubling' section.  So entries there override
153                           # entries in the rest o the file.
154                           $_ ne $e && $_->{In} eq $e->{In}
155                       } @exp;
156                   },
157                   sub {
158                       $_=$_[0];
159                       s/\$/\$\$/g unless $_[1]{DD};
160                       $_;
161                   } );
162     write_permode($dir_prefix,
163                   "&:changequote NEWQUOTE\n",
164                   "NEWQUOTE:changequote &\n",
165                   "",
166                   'changequote',
167                   sub { $_[0]{CQ} } );
168     oh "# doctests end\n";
169     close I or die $!;
170 }
171
172 writeout('');
173 writeout('sub/dir/');