2 # subdirmk - script for extracting doctests from README
3 # Copyright 2019 Mark Wooding
4 # Copyright 2019 Ian Jackson
5 # SPDX-License-Identifier: LGPL-2.0-or-later
6 # There is NO WARRANTY.
9 # expand <README | tests/filter/extract-doctests tests/filter/
11 # tests/filter/doctests.mk.part
12 # tests/filter/sub/dir/doctests.mk.part
14 # Relies on some properties of the way README is laid out.
15 # See comments below marked `parse:' and `adhoc:'.
30 my $withspcs = qr{\S+(?: \S+)*};
32 my $outdir = shift @ARGV // confess;
35 # adhoc: rely on structure of indented examples in &:changequote part
36 $in_changequote = (m{^\&\:changequote}...m{^\S}) && m{^\s};
37 if (m{^-----|^- - - - -}) {
38 # parse: rely on underlines for (sub)section headings
44 # parse: rely on looking for => (and .. on subsequent lines)
45 next unless m{\=\>} or ($cent and m{ \.\. });
47 # adhoc: special case NEWQUOTE here so we recognise things in changequote
48 if (s{^(\s*)(\&\S+|NEWQUOTE\S+|\$)\s+(\=\>|\.\.)\s+(\S+)\s+}{} ||
49 s{^()(\&\:\w+(?: \S+)*)\s{2,}(\=\>)\s{2,}($withspcs)$}{} ||
50 $cent && s{^()($withspcs)\s{2,}(\.\.)\s{2,}($withspcs)$}{}) {
51 # adhoc: expected indented iff in changequote part
52 confess if length($1) xor $in_changequote;
54 confess if !$cent && $mapop ne '=>';
57 if (# adhoc: `or ...' introduces the `at toplevel' expansion
59 $e->{OutTop} = $1 eq 'nothing' ? '' : $1;
60 } elsif (# parse: expect other wordish things to be comments
61 m{^(?!or\b)\(?\w{2,} }) {
62 } elsif (# adhoc: slightly special case for $(eval $(call
67 confess "unk rhs $_ ?";
69 $e->{CQ} = $in_changequote;
70 # adhoc: rely on this specific section title
71 $e->{DD} = $csection =~ m{^while dollar[- ]doubling}i;
76 if ($e->{In} =~ m/\bNN\b/) {
77 # adhoc: special case NN in examples
78 confess if defined $cent->{OutTop};
79 foreach my $nn (0..11, 999) {
81 foreach my $k (qw(In Out)) {
83 ($f->{$k} =~ s/\bNN\b/$nn/g) == 1 or confess;
92 } elsif ($mapop eq '..') {
93 confess if defined $cent->{OutTop};
94 foreach my $k (qw(In Out)) {
95 $cent->{$k} .= "\n".$e->{$k};
102 sub oi { print I @_ or die $!; }
103 sub oo { print O @_ or die $!; }
104 sub oh { oi @_; oo @_; }
106 sub write_permode ($$$$$;$$) {
107 my ($dir_prefix, $start, $end, $senl, $what,
108 $filter, $omap) = @_;
109 $filter //= sub { 1 };
110 $omap //= sub { $_[0] };
112 oh "${senl}# ----- $what starts -----\n";
113 foreach my $e (@exp) {
114 next unless $filter->($e);
116 $desc =~ s/\&/AMP /g;
117 $desc =~ s/\$/DOLLAR /g;
118 $desc =~ s/NEWQUOTE/NEW_QUOTE /g;
119 my ($f,$pdesc) = $desc =~ m/^(.*)\n/
120 ? ("\n# %s:\n%s\n\n", $1)
121 : ("%-30s: %s .\n", $desc);
123 $o = $e->{OutTop} if $dir_prefix eq '';
125 $o =~ s{/sub/dir}{} if $dir_prefix eq '' && !defined $e->{OutTop};
126 $o = $omap->($o, $e);
127 oi sprintf $f, $pdesc, $e->{In};
128 oo sprintf $f, $pdesc, $o;
131 oh "${senl}# ----- $what ends -----\n";
135 my ($dir_prefix) = @_;
136 open I, '>', "$outdir/${dir_prefix}doctests.sd.mk" or die $!;
137 open O, '>', "$outdir/${dir_prefix}doctests.mk.part" or die $!;
138 oh "# doctests start $dir_prefix\n";
139 write_permode($dir_prefix,
141 sub { !$_[0]{DD} && !$_[0]{CQ} } );
142 write_permode($dir_prefix,
147 # adhoc: skip &:macro in already-doubling part
148 return 0 if $e->{In} =~ m{^\&\:macro};
149 # adhoc: skip &${ ie eval in already-doubling part
150 return 0 if $e->{In} =~ m{^\&\{};
151 return 0 if $e->{CQ};
152 return $e->{DD} || !grep {
153 # If there are two entries with the same In,
154 # use only the one from the `while dollar
155 # doubling' section. So entries there override
156 # entries in the rest o the file.
157 $_ ne $e && $_->{In} eq $e->{In}
162 s/\$/\$\$/g unless $_[1]{DD};
165 write_permode($dir_prefix,
166 "&:changequote NEWQUOTE\n",
167 "NEWQUOTE:changequote &\n",
171 oh "# doctests end\n";
176 writeout('sub/dir/');