tests/filter/extract-doctest

   1 #!/usr/bin/perl -w
   2 #
   3 # script for extracting doctests from README
   4 #
   5 # usage:
   6 #   expand <README | tests/filter/extract-doctest tests/filter/
   7 # writes:
   8 #   tests/filter/doctest.mk.part
   9 #   tests/filter/sub/dir/doctest.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 (m/^$/) {
  60         } else {
  61             confess "unk rhs $_ ?";
  62         }
  63         $e->{CQ} = $in_changequote;
  64         # adhoc: rely on this specific section title
  65         $e->{DD} = $csection =~ m{^while dollar[- ]doubling}i;
  66     } else {
  67         confess "$_ ?";
  68     }
  69     if ($mapop eq '=>') {
  70         if ($e->{In} =~ m/\bNN\b/) {
  71             # adhoc: special case NN in examples
  72             confess if defined $cent->{OutTop};
  73             foreach my $nn (0..11, 999) {
  74                 my $f = { %$e };
  75                 foreach my $k (qw(In Out)) {
  76                     $f->{$k} = $e->{$k};
  77                     ($f->{$k} =~ s/\bNN\b/$nn/g) == 1 or confess;
  78                 }
  79                 push @exp, $f;
  80             }
  81             $cent=undef;
  82         } else {
  83             push @exp, $e;
  84             $cent=$e;
  85         }
  86     } elsif ($mapop eq '..') {
  87         confess if defined $cent->{OutTop};
  88         foreach my $k (qw(In Out)) {
  89             $cent->{$k} .= "\n".$e->{$k};
  90         }
  91     }
  92 }
  93
  94 print Dumper(\@exp);
  95
  96 sub oi { print I @_ or die $!; }
  97 sub oo { print O @_ or die $!; }
  98 sub oh { oi @_; oo @_; }
  99
 100 sub write_permode ($$$$$;$$) {
 101     my ($dir_prefix, $start, $end, $senl, $what,
 102         $filter, $omap) = @_;
 103     $filter //= sub { 1 };
 104     $omap //= sub { $_[0] };
 105     oi $start;
 106     oh "${senl}# ----- $what starts -----\n";
 107     foreach my $e (@exp) {
 108         next unless $filter->($e);
 109         my $rubric = $e->{In};
 110         $rubric =~ s/\&/AMP /g;
 111         $rubric =~ s/\$/DOLLAR /g;
 112         $rubric =~ s/NEWQUOTE/NEW_QUOTE /g;
 113         my $f = $e->{In} =~ m/\n/
 114                 ? "\n# %s:\n%s\n\n"
 115                 : "%-30s: %s.\n";
 116         my $o;
 117         $o = $e->{OutTop} if $dir_prefix eq '';
 118         $o //= $e->{Out};
 119         $o =~ s{/sub/dir}{} if $dir_prefix eq '' && !defined $e->{OutTop};
 120         $o = $omap->($o, $e);
 121         oi sprintf $f, $rubric, $e->{In};
 122         oo sprintf $f, $rubric, $o;
 123     }
 124     oi $end;
 125     oh "${senl}# ----- $what ends -----\n";
 126 }
 127
 128 sub writeout ($) {
 129     my ($dir_prefix) = @_;
 130     open I, '>', "$outdir/${dir_prefix}doctest.sd.mk" or die $!;
 131     open O, '>', "$outdir/${dir_prefix}doctest.mk.part" or die $!;
 132     oh "# doctest starts $dir_prefix\n";
 133     write_permode($dir_prefix,
 134                   '','','', 'normal',
 135                  sub { !$_[0]{DD} && !$_[0]{CQ} } );
 136     write_permode($dir_prefix,
 137                   '&$+', '&$-', "\n",
 138                   'dollar doubling',
 139                   sub {
 140                       my ($e) = @_;
 141                       return 0 if $e->{CQ};
 142                       return $e->{DD} || !grep {
 143                           # If there are two entries with the same In,
 144                           # use only the one from the `while dollar
 145                           # doubling' section.  So entries there override
 146                           # entries in the rest o the file.
 147                           $_ ne $e && $_->{In} eq $e->{In}
 148                       } @exp;
 149                   },
 150                   sub {
 151                       $_=$_[0];
 152                       s/\$/\$\$/g unless $_[1]{DD};
 153                       $_;
 154                   } );
 155     write_permode($dir_prefix,
 156                   "&:changequote NEWQUOTE\n",
 157                   "NEWQUOTE:changequote &\n",
 158                   "",
 159                   'changequote',
 160                   sub { $_[0]{CQ} } );
 161     oh "# doctest ends\n";
 162     close I or die $!;
 163 }
 164
 165 writeout('');
 166 writeout('sub/dir/');