tests/filter/extract-doctests

   1 #!/usr/bin/perl -w
   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.
   7 #
   8 # usage:
   9 #   expand <README | tests/filter/extract-doctests tests/filter/
  10 # writes:
  11 #   tests/filter/doctests.mk.part
  12 #   tests/filter/sub/dir/doctests.mk.part
  13 #
  14 # Relies on some properties of the way README is laid out.
  15 # See comments below marked `parse:' and `adhoc:'.
  16
  17 use strict;
  18 use Carp;
  19 use Data::Dumper;
  20
  21 our @exp;
  22 # $exp[]{In}
  23 # $exp[]{Out}
  24 # $exp[]{OutTop}
  25
  26 my $cent;
  27 my $in_changequote;
  28 my $lastl;
  29 my $csection;
  30 my $withspcs = qr{\S+(?: \S+)*};
  31
  32 my $outdir = shift @ARGV // confess;
  33
  34 while (<>) {
  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
  39         $csection = $lastl;
  40         next;
  41     }
  42     $lastl = $_;
  43     my $e = { L => $. };
  44     # parse: rely on looking for => (and .. on subsequent lines)
  45     next unless m{\=\>} or ($cent and m{ \.\. });
  46     my $mapop = '=>';
  47     # adhoc: special case NEWQUOTE here so we recognise things in changequote
  48     if (s{^()(\&\:\w+(?: \S+)*)\s{2,}(\=\>)\s{2,}($withspcs)$}{} ||
  49         s{^(\s*)(\&\S+|NEWQUOTE\S+|\$)\s+(\=\>|\.\.)\s+(\S+)\s+}{} ||
  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;
  53         $mapop = $3;
  54         confess if !$cent && $mapop ne '=>';
  55         $e->{In} = $2;
  56         $e->{Out} = $4;
  57         if (# adhoc: `or ...' introduces the `at toplevel' expansion
  58             s{^or (\S+)$}{}) {
  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
  63                  m{^\$\{.*}) {
  64             $e->{Out} .= ' '.$&;
  65         } elsif (m/^$/) {
  66         } else {
  67             confess "unk rhs $_ (In=\"$e->{In}\" out=\"$e->{Out}\"?";
  68         }
  69         $e->{CQ} = $in_changequote;
  70         # adhoc: rely on this specific section title
  71         $e->{DD} = $csection =~ m{^while dollar[- ]doubling}i;
  72     } else {
  73         confess "$_ ?";
  74     }
  75     if ($mapop eq '=>') {
  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) {
  80                 my $f = { %$e };
  81                 foreach my $k (qw(In Out)) {
  82                     $f->{$k} = $e->{$k};
  83                     ($f->{$k} =~ s/\bNN\b/$nn/g) == 1 or confess;
  84                 }
  85                 push @exp, $f;
  86             }
  87             $cent=undef;
  88         } else {
  89             push @exp, $e;
  90             $cent=$e;
  91         }
  92     } elsif ($mapop eq '..') {
  93         confess if defined $cent->{OutTop};
  94         foreach my $k (qw(In Out)) {
  95             $cent->{$k} .= "\n".$e->{$k};
  96         }
  97     }
  98 }
  99
 100 print Dumper(\@exp);
 101
 102 sub oi { print I @_ or die $!; }
 103 sub oo { print O @_ or die $!; }
 104 sub oh { oi @_; oo @_; }
 105
 106 sub write_permode ($$$$$;$$) {
 107     my ($dir_prefix, $start, $end, $senl, $what,
 108         $filter, $omap) = @_;
 109     $filter //= sub { 1 };
 110     $omap //= sub { $_[0] };
 111     oi $start;
 112     oh "${senl}# ----- $what starts -----\n";
 113     foreach my $e (@exp) {
 114         next unless $filter->($e);
 115         my $desc = $e->{In};
 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);
 122         my $o;
 123         $o = $e->{OutTop} if $dir_prefix eq '';
 124         $o //= $e->{Out};
 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;
 129     }
 130     oi $end;
 131     oh "${senl}# ----- $what ends -----\n";
 132 }
 133
 134 sub writeout ($) {
 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,
 140                   '','','', 'normal',
 141                  sub { !$_[0]{DD} && !$_[0]{CQ} } );
 142     write_permode($dir_prefix,
 143                   '&$+', '&$-', "\n",
 144                   'dollar doubling',
 145                   sub {
 146                       my ($e) = @_;
 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}
 158                       } @exp;
 159                   },
 160                   sub {
 161                       $_=$_[0];
 162                       s/\$/\$\$/g unless $_[1]{DD};
 163                       $_;
 164                   } );
 165     write_permode($dir_prefix,
 166                   "&:changequote NEWQUOTE\n",
 167                   "NEWQUOTE:changequote &\n",
 168                   "",
 169                   'changequote',
 170                   sub { $_[0]{CQ} } );
 171     oh "# doctests end\n";
 172     close I or die $!;
 173 }
 174
 175 writeout('');
 176 writeout('sub/dir/');