3 # script for extracting doctests from README
6 # expand <README | tests/filter/extract-doctest tests/filter/
8 # tests/filter/doctest.mk.part
9 # tests/filter/sub/dir/doctest.mk.part
11 # Relies on some properties of the way README is laid out.
12 # See comments below marked `parse:' and `adhoc:'.
27 my $withspcs = qr{\S+(?: \S+)*};
29 my $outdir = shift @ARGV // confess;
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
41 # parse: rely on looking for => (and .. on subsequent lines)
42 next unless m{\=\>} or ($cent and m{ \.\. });
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;
51 confess if !$cent && $mapop ne '=>';
54 if (# adhoc: `or ...' introduces the `at toplevel' expansion
56 $e->{OutTop} = $1 eq 'nothing' ? '' : $1;
57 } elsif (# parse: expect other wordish things to be comments
58 m{^(?!or\b)\w{2,} }) {
61 confess "unk rhs $_ ?";
63 $e->{CQ} = $in_changequote;
68 if ($e->{In} =~ m/\bNN\b/) {
69 # adhoc: special case NN in examples
70 confess if defined $cent->{OutTop};
71 foreach my $nn (0..11, 999) {
73 foreach my $k (qw(In Out)) {
75 ($f->{$k} =~ s/\bNN\b/$nn/g) == 1 or confess;
84 } elsif ($mapop eq '..') {
85 confess if defined $cent->{OutTop};
86 foreach my $k (qw(In Out)) {
87 $cent->{$k} .= "\n".$e->{$k};
94 sub oi { print I @_ or die $!; }
95 sub oo { print O @_ or die $!; }
96 sub oh { oi @_; oo @_; }
98 sub write_permode ($$$$$;$$) {
99 my ($dir_prefix, $start, $end, $senl, $what,
100 $filter, $omap) = @_;
101 $filter //= sub { 1 };
102 $omap //= sub { $_[0] };
104 oh "${senl}# ----- $what starts -----\n";
105 foreach my $e (@exp) {
106 next unless $filter->($e);
107 my $rubric = $e->{In};
108 $rubric =~ s/\&/AMP /g;
109 $rubric =~ s/\$/DOLLAR /g;
110 $rubric =~ s/NEWQUOTE/NEW_QUOTE /g;
111 my $f = $e->{In} =~ m/\n/
115 $o = $e->{OutTop} if $dir_prefix eq '';
117 $o =~ s{/sub/dir}{} if $dir_prefix eq '' && !defined $e->{OutTop};
118 $o = $omap->($o, $e);
119 oi sprintf $f, $rubric, $e->{In};
120 oo sprintf $f, $rubric, $o;
123 oh "${senl}# ----- $what ends -----\n";
127 my ($dir_prefix) = @_;
128 open I, '>', "$outdir/${dir_prefix}doctest.sd.mk" or die $!;
129 open O, '>', "$outdir/${dir_prefix}doctest.mk.part" or die $!;
130 oh "# doctest starts $dir_prefix\n";
131 write_permode($dir_prefix,
133 sub { !$_[0]{CQ} } );
134 write_permode($dir_prefix,
135 "&:changequote NEWQUOTE\n",
136 "NEWQUOTE:changequote &\n",
140 oh "# doctest ends\n";
145 writeout('sub/dir/');