From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Sun, 22 Dec 2019 18:27:10 +0000 (+0000)
Subject: doctests: Provide extract-doctest
X-Git-Tag: subdirmk/0.3~108
X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ian/git?p=subdirmk.git;a=commitdiff_plain;h=8df0559baf489581ba2f7decc8f3b6854df7fc52;hp=ee295f5f320fc8db7f789da3198a751b1cc7ddd3

doctests: Provide extract-doctest

This is not called yet.  There are a few things that need fixing
first.

Signed-off-by: Ian Jackson <ijackson@chiark.greenend.org.uk>
---

diff --git a/tests/filter/extract-doctest b/tests/filter/extract-doctest
new file mode 100755
index 0000000..b7da9ac
--- /dev/null
+++ b/tests/filter/extract-doctest
@@ -0,0 +1,141 @@
+#!/usr/bin/perl -w
+#
+# script for extracting doctests from README
+#
+# usage:
+#   expand <README | tests/filter/extract-doctest tests/filter/
+# writes:
+#   tests/filter/doctest.mk.part
+#   tests/filter/sub/dir/doctest.mk.part
+#
+# Relies on some properties of the way README is laid out.
+# See comments below marked `parse:' and `adhoc:'.
+
+use strict;
+use Carp;
+use Data::Dumper;
+
+our @exp;
+# $exp[]{In}
+# $exp[]{Out}
+# $exp[]{OutTop}
+
+my $cent;
+my $in_changequote;
+my $lastl;
+my $csection;
+my $withspcs = qr{\S+(?: \S+)*};
+
+my $outdir = shift @ARGV // confess;
+
+while (<>) {
+    # adhoc: rely on structure of indented examples in &:changequote part
+    $in_changequote = (m{^\&\:changequote}...m{^\S}) && m{^\s};
+    if (m{^-----|^- - - - -}) {
+	# parse: rely on underlines for (sub)section headings
+	$csection = $lastl;
+	next;
+    }
+    $lastl = $_;
+    my $e = { L => $. };
+    # parse: rely on looking for => (and .. on subsequent lines)
+    next unless m{\=\>} or ($cent and m{ \.\. });
+    my $mapop = '=>';
+    # adhoc: special case STUFF here so we recognise things in changequote
+    if (s{^(\s*)(\&\S+|STUFF\S+|\$)\s+(\=\>|\.\.)\s+(\S+)\s+}{} ||
+	s{^()(\&\:\w+(?: \S+)*)\s{2,}(\=\>)\s{2,}($withspcs)$}{} ||
+        $cent && s{^()($withspcs)\s{2,}(\.\.)\s{2,}($withspcs)$}{}) {
+	# adhoc: expected indented iff in changequote part
+	confess if length($1) xor $in_changequote;
+	$mapop = $3;
+	confess if !$cent && $mapop ne '=>';
+	$e->{In} = $2;
+	$e->{Out} = $4;
+	if (# adhoc: `or ...' introduces the `at toplevel' expansion
+	    s{^or (\S+)$}{}) {
+	    $e->{OutTop} = $1 eq 'nothing' ? '' : $1;
+	} elsif (# parse: expect other wordish things to be comments
+		 m{^(?!or\b)\w{2,} }) {
+	}
+	$e->{CQ} = $in_changequote;
+    } else {
+	confess "$_ ?";
+    }
+    if ($mapop eq '=>') {
+	if ($e->{In} =~ m/\bNN\b/) {
+	    # adhoc: special case NN in examples
+	    confess if defined $cent->{OutTop};
+	    foreach my $nn (0..11, 999) {
+		my $f = { %$e };
+		foreach my $k (qw(In Out)) {
+		    $f->{$k} = $e->{$k};
+		    ($f->{$k} =~ s/\bNN\b/$nn/g) == 1 or confess;
+		}
+		push @exp, $f;
+	    }
+	    $cent=undef;
+	} else {
+	    push @exp, $e;
+	    $cent=$e;
+	}
+    } elsif ($mapop eq '..') {
+	confess if defined $cent->{OutTop};
+	foreach my $k (qw(In Out)) {
+	    $cent->{$k} .= "\n".$e->{$k};
+	}
+    }
+}
+
+print Dumper(\@exp);
+
+sub oi { print I @_ or die $!; }
+sub oo { print O @_ or die $!; }
+sub oh { oi @_; oo @_; }
+
+sub write_permode ($$$$$;$$) {
+    my ($dir_prefix, $start, $end, $senl, $what,
+	$filter, $omap) = @_;
+    $filter //= sub { 1 };
+    $omap //= sub { $_[0] };
+    oi $start;
+    oh "${senl}# ----- $what starts -----\n";
+    foreach my $e (@exp) {
+	next unless $filter->($e);
+	my $rubric = $e->{In};
+	$rubric =~ s/\&/AMP /g;
+	$rubric =~ s/\$/DOLLAR /g;
+	my $f = $e->{In} =~ m/\n/
+	        ? "\n# %s:\n%s\n\n"
+		: "%-30s: %s.\n";
+	my $o;
+	$o = $e->{OutTop} if $dir_prefix eq '';
+	$o //= $e->{Out};
+	$o =~ s{/sub/dir}{} if $dir_prefix eq '' && !defined $e->{OutTop};
+	$o = $omap->($o, $e);
+	oi sprintf $f, $rubric, $e->{In};
+	oo sprintf $f, $rubric, $o;
+    }
+    oi $end;
+    oh "${senl}# ----- $what ends -----\n";
+}
+    
+sub writeout ($) {
+    my ($dir_prefix) = @_;
+    open I, '>', "$outdir/${dir_prefix}doctest.sd.mk" or die $!;
+    open O, '>', "$outdir/${dir_prefix}doctest.mk.part" or die $!;
+    oh "# doctest starts $dir_prefix\n";
+    write_permode($dir_prefix,
+		  '','','', 'normal',
+		 sub { !$_[0]{CQ} } );
+    write_permode($dir_prefix,
+		  "&:changequote STUFF",
+		  "STUFF:changequote &",
+		  "\n",
+		  'changequote',
+		  sub { $_[0]{CQ} } );
+    oh "# doctest ends\n";
+    close I or die $!;
+}
+
+writeout('');
+writeout('sub/dir/');