The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# -*- perl -*-
# A common SlayMakefile for executing tests
# It is intended to be called from two levels lower in the directory
# hierarchy using "slaymake -f ../../Common.smak <target>".

{

=head1 NAME

Common.smak

=head1 DESCRIPTION

Used as the common C<Slay::Makefile> input for all the
C<Text::Restructured> tests.  It contains all the infrastructure needed
for executing the python tests from docutils, while still providing
tailorability for tests that do not fit the framework.  The tests are
divided into suites (e.g., C<10_parse>), each of which can have more
than one C<.t> file in it with its associated C<.init> directory to
implement multiple related tests.  The customizability comes the
following files (relative to the C<.dir> directory created by C<gress.pm>):

=over

=item ../Suite.smak

If it exists, overrides variables for the entire suite.

=item Dir.smak

If it exists, allows overriding for the directory and for individual
tests within the directory

=back

=head1 TARGETS

=over

=item pretest

Returns the dependencies in global variable C<@PRETESTS>, which is
initialized to the targets C<unpack> and C<find_oks>, but can be added
to by the custom C<Slay::Makefile> files above.

=item unpack

Checks for a python test file and, if it exists, calls the
C<extract_tests> script from the C<tbin> directory on it to create a
series of C<.rst> and C<.dom> files for testing.

=item find_oks

Sets the global variable C<@OKS> to contain the list of C<.rst> files
in the directory with the C<.rst> extension replaced by C<.ok>.
Override this target if there is a different way to determine the list
of targets corresponding to tests.

=item test

Returns the global variable C<@OKS>.

=item %.ok

Looks for an expect file for the C<$1> part (the part matching the
first C<%>) in order to determine which writer to use when calling
C<prest>.  For writer C<xyz>, the expect file should be one of

=over

=item C<$1.xyz>

The unpacked python expects all have this form.

=item C<$1.myxyz>

Sometimes prest intentionally does not match the python output, so
C<$1.myxyz> is used in preference to C<$1.xyz> if both exist.

=item C<$1.xyz.re>

Sometimes a regular expression difference, using the C<rediff> script
in the C<tbin> directory, needs to be done for fault grading.  This
file contains regular expressions and is used in preference to either
of the previous two.

=back

Note: There are two exceptions to the one-to-one mapping between
C<xyz> and the writer namely, namely C<tex> runs the C<latex> writer
and C<idx> runs the C<index> writer.

This target returns an error if no expect file for a known writer is
found.

After determining which writer is appropriate, this target returns two
dependencies, one of which will be the output of the writer
(C<$1.xyz.out>), and the other of which is the file against which
fault grading occurs.  If the expect file has extension C<.xyz.re>,
then C<rediff> is used for fault grading, and the fault grading file
is C<$1.xyz.re>.  Otherwise, C<diff> is used for fault grading and 
the fault grading file is C<$1.xyz.df>.  If a C<diff> fault grading
fails, then the <$1.ok> target repeats the fault grading using
C<rediff>.

=item %.%.df

Copies C<$1.stderr>, if it exists, and the first of C<$1.my$2> or
C<$1.$2> to the target, where C<$2> is the writer.  Thus, any error
messages printed to STDERR become part of the fault grading.

=item %.%.re

If there was already a C<$1.$2.re> file, this rule does nothing.
Otherwise, it was invoked because the straight C<diff> failed.  It passes
C<$1.stderr>, if it exists, and the first of C<$1.my$2> or C<$1.$2> as
arguments to the script C<re$2> (e.g., C<redom>), located in the
C<tbin> directory.  The purpose of such a script is to elide with
regular expressions that part of the output that can validly differ.

=item %.%.out%

Dependencies are C<$1.rst> (if it exists), the C<prest> script, and
the file containing the implemention of the writer C<$2>.  Invokes

  perl $PERL_FILE_FLAGS{$1} $PERL_DIR_FLAGS $PERL_SUITE_FLAGS \
       $PERL_WRT_FLAGS{$2} $PERL_FLAGS -I <root>/blib/lib \
       <root>/blib/script/prest -w $2 \
       $PREST_FLAGS $PREST_WRT_FLAGS{$2} $PREST_SUITE_FLAGS \
       $PREST_DIR_FLAGS $PREST_FILE_FLAGS{$1} [$1.rst] \
       $POSTPROC_FILE{$1} > $target

If C<$3> is null, then any output to STDERR is captured in the output
file; otherwise the output file contains only the prest output to STDOUT.
If there is no C<$1.rst> file, then C<$PREST_FILE_FLAGS{$1}> should
contain the list of input files.

=back

=head1 GLOBAL VARIABLES

As can be seen above, there are a number of global variables that
affect the processing of the prest command:

=over

=item C<$PERL_DIR_FLAGS> (Dir.smak)

Flags for perl invocation of prest for a directory.

=item C<$PERL_SUITE_FLAGS> (Suite.smak)

Flags for perl invocation of prest for a suite.

=item C<%PERL_WRT_FLAGS> (Suite.smak or Perl.smak)

Flags for perl invocation of prest for specific writers (indexed by
writer).

=item C<%PERL_FILE_FLAGS> (Dir.smak)

Flags for perl invocation of prest for specific files (indexed by base
filename).

=item C<$PREST_DIR_FLAGS> (Dir.smak)

Writer- and file-independent flags for prest for a directory.

=item C<$PREST_FLAGS> (Suite.smak or Dir.smak)

Writer- and file-independent flags for prest.  Defaults to 

  -D source='test data' -D xformoff='.*' -D align=0

unless already set.

=item C<$PREST_SUITE_FLAGS> (Suite.smak)

Writer- and file-independent flags for prest for a suite.

=item C<%PREST_WRT_FLAGS> (Suite.smak or Dir.smak)

Flags for specific writers (indexed by writer).  C<$PREST_WRT_FLAGS{dom}>
defaults to "-W nobackn" unless already set.

=item C<%PREST_FILE_FLAGS> (Dir.smak)

Flags for specific files (indexed by base filename).

=item C<%POSTPROC_FILE> (Dir.smak)

Text for postprocessing output before check for specific files
(indexed by base filename).  Usually starts with "|".

=back

=head1 ENVIRONMENT VARIABLES

=over

=item C<COVER>

If set, runs perl with flags to create a coverage database using
C<Devel::Cover>.

=item C<DEBUG>

If set, runs perl with the C<-d> flag (debug mode).

=item C<PRINT>

If set, echoes to STDERR the commands to be executed, but does not
actually execute them.

=item C<TRACE>

If set, echoes to STDERR the commands as they execute.

=back

=cut
}

default: test

{
    use strict;
    use vars qw(@OKS @PRETESTS);
    # Flags that can be set in Suite.smak and Dir.smak:
    #   $EXTRACT_TEST_FLAGS Flags for extract_tests script
    #   $PERL_DIR_FLAGS     Flags for perl invocation of prest for a directory
    #   $PERL_SUITE_FLAGS   Flags for perl invocation of prest for a suite
    #   %PERL_WRT_FLAGS     Flags for perl invocation of prest for specific
    #                       writers (indexed by writer)
    #   %PERL_FILE_FLAGS    Flags for perl infocation of prest for specific
    #                       files (indexed by base filename)
    #   $PREST_DIR_FLAGS    Generic flags for prest for a directory
    #   $PREST_FLAGS        Generic flags for prest
    #   $PREST_SUITE_FLAGS  Generic flags for prest for a suite
    #   %PREST_WRT_FLAGS    Flags for specific writers (indexed by writer)
    #   %PREST_FILE_FLAGS   Flags for specific files (indexed by base filename)
    #   %POSTPROC_FILE      Text for postprocessing output before check for
    #                       specific files (indexed by base filename).  Usually
    #                       starts with "|".
    
    use vars qw(%EXT_TO_WRT $EXTRACT_TEST_FLAGS $PREST_FLAGS
		$PERL_DIR_FLAGS $PERL_SUITE_FLAGS %PERL_WRT_FLAGS
		%PERL_FILE_FLAGS
		%POSTPROC_FILE
		$PREST_DIR_FLAGS $PREST_SUITE_FLAGS %PREST_WRT_FLAGS
		%PREST_FILE_FLAGS);

    %EXT_TO_WRT = (tex => 'latex', idx => 'index');
    $EXTRACT_TEST_FLAGS = '';
    @PRETESTS = qw(unpack find_oks);
    # Executes a command line while possibly echoing it to the screen
    sub execute ( $ ) {
	my ($cmd) = @_;
	print STDERR "\t$cmd\n" if $ENV{TRACE} || $ENV{PRINT};
	system $cmd unless $ENV{PRINT};
	return;
    }
}

# Include the suite's SlayMakefile if it exists
-include ../Suite.smak

# Include the directory's SlayMakefile if it exists
-include Dir.smak

test: { @OKS }

pretest: { @PRETESTS } 

{ 
    # Set up our make variables
    use strict;
    use vars qw($EXTRACT_TESTS $LIB $PERL $PERL_FLAGS $SCRIPT $TBIN $TOP
		@WRITERS);

    # Find our top directory
    chomp ($TOP = `pwd`);
    $TOP =~ s!/t/.*$!!;
    $TBIN   = "$TOP/tbin";
    $SCRIPT = "$TOP/blib/script";
    $LIB    = "$TOP/blib/lib";
    $EXTRACT_TESTS = "$TBIN/extract_tests";
    $PERL   = $^X;
    # Get list of writers
    my ($dir, @writers, %writer_seen);
    foreach $dir (@INC) {
	push @writers, glob("$dir/Text/Restructured/Writer/*.wrt")
    }
    @WRITERS = grep(! $writer_seen{$_}++,
		    grep(s|.*/([^/]+)\.wrt$|$1|, @writers));
    eval "use lib \$LIB; use Text::Restructured::PrestConfig;";

    my @flags;
    push @flags, '-T' if $Text::Restructured::PrestConfig::TAINT =~ /^y/i;
    push @flags, '-d' if $ENV{DEBUG};
    push @flags, '-MDevel::Cover=-db,../../cover_db,-silent,1,-summary,0'
	if $ENV{COVER};
    push @flags, q(-M-warnings) if $ENV{COVER};
    $PERL_FLAGS = "@flags";
    # Default version of PREST_FLAGS
    $PREST_FLAGS = q(-D source='test data' -D xformoff='.*' -D align=0)
	unless defined $PREST_FLAGS;
    $PREST_FLAGS .= q( -D no_line_directives) if $ENV{DEBUG};
    # Default version of PREST_WRT_FLAGS for dom
    $PREST_WRT_FLAGS{dom} = '-W nobackn' unless defined $PREST_WRT_FLAGS{dom};
}

# Unpack the .py file if it exists
unpack:
	{ 
	    my @test_pys = <test_*.py>;
	    foreach (@test_pys) {
		execute "$PERL $EXTRACT_TESTS $EXTRACT_TEST_FLAGS $_";
	    }
	}

find_oks:
	{
	    @OKS = <*.rst>;
	    s/\.rst$/.ok/ foreach @OKS;
	}

# Fault grading.  This is complicated because we can do either diff or
# rediff for checking and we can build the targets in a number of ways,
# depending upon which writer needs to be used, which depends upon
# what kinds of expects we have
%.ok:   {
	    my($maker, $target, $matches) = @_;
	    my $m = $matches->[0];
	    # Search for .xyz or .myxyz or .xyzre files for each of
	    # the different writers xyz
	    my @writers = grep(-f "$m.$_" || -f "$m.my$_" ||
			       -f "$m.$_.re",
			       (@WRITERS, qw(tex idx txt)));
	    my $writer = $writers[0];
	    die "Cannot find expect file for $m" unless defined $writer;
	    my $ext = -f "$m.r" || -f "$m.$writer.re" ? 're' : 'df';
	    ("$m.$writer.$ext", "$m.$writer.out");
	}
	# ---- ACTIONS ----
	{
            my($maker, $target, $deps, $matches) = @_;
	    my $is_diff = $deps->[0] =~ /\.df/;
	    my $diffre = "$PERL $TBIN/diffre";
	    my $prog = $is_diff ? 'diff' : $diffre;
	    execute "$prog @$deps[0..1] > $target";
	    if (! -z $target && $is_diff) {
		$deps->[0] =~ s/\.df$/.re/;
		$maker->make($deps->[0]);
		execute "$diffre @$deps[0..1] > $target";
	    }
	}

# Make a straight diff file
%.%.df:	{ 
	    my($maker, $target, $matches) = @_;
	    my @exp = grep(-f $_, "$matches->[0].my$matches->[1]",
			   "$matches->[0].$matches->[1]");
	    my @files;
	    push @files, "$matches->[0].stderr" if -f "$matches->[0].stderr";
	    push @files, $exp[0];
	    @files;
	}
	# ---- ACTIONS ----
	cat $DEP0 $DEP1 > $TARGET

# Make a regular expression diff file
%.%.re:	{ 
	    my($maker, $target, $matches) = @_;
	    my @exp = grep(-f $_, "$matches->[0].my$matches->[1]",
			   "$matches->[0].$matches->[1]");
	    my @files;
	    push @files, "$matches->[0].stderr" if -f "$matches->[0].stderr";
	    push @files, $exp[0] if $exp[0];
	    @files;
	}
	# ---- ACTIONS ----
	{
            my($maker, $target, $deps, $matches) = @_;
	    my $dep = $deps->[-1];
	    $dep =~ /\. (my)? ([^\.]+?) \z/x;
	    my $re = $2;
	    execute "$PERL $TBIN/re$re @$deps > $target";
	}

# Run prest with the appropriate writer
# Anything after the ".out" causes the output to be generated without STDERR.
%.%.out%: {
	    # Add the prest script and the appropriate writer as dependencies
	    my($maker, $target, $matches) = @_;
	    my $writer = $EXT_TO_WRT{$matches->[1]} || $matches->[1];
	    my @deps;
	    # Make the .rst file a dependency if it exists (it usually does)
	    push @deps, "$matches->[0].rst" if -f "$matches->[0].rst";
	    # Add the prest script and perl modules to the dependencies
	    push @deps, ("$SCRIPT/prest",
			 "$LIB/Text/Restructured/Writer/$writer.wrt");
	    push @deps, (<$LIB/Text/*.pm>, <$LIB/Text/Restructured/*.pm>,
			 <$LIB/Text/Restructured/Directive/*.pm>);
	    @deps
	}
	# ---- ACTIONS ----
	{
            my($maker, $target, $deps, $matches) = @_;
	    my $m0 = $matches->[0];
	    my $writer = $EXT_TO_WRT{$matches->[1]} || $matches->[1];
	    # Note: since these are usually -I flags, the local ones come first
	    my @perl_flags =
		grep(defined $_, $PERL_FILE_FLAGS{$m0},
		     $PERL_DIR_FLAGS, $PERL_SUITE_FLAGS,
		     $PERL_WRT_FLAGS{$writer}, $PERL_FLAGS, );
	    my $prest_cmd = "$PERL @perl_flags -I $LIB $SCRIPT/prest";
	    my @flags =
		grep(defined $_, $PREST_FLAGS, $PREST_WRT_FLAGS{$writer},
		     $PREST_SUITE_FLAGS, $PREST_DIR_FLAGS, 
		     $PREST_FILE_FLAGS{$m0});
	    push @flags, "$m0.rst" if -f "$m0.rst";
	    my $redir    = $matches->[2] ? '' : '2>&1' ;
	    my $postproc = $POSTPROC_FILE{$m0} || '';
	    my $redirect = $ENV{DEBUG} ? '' : "> $target";
	    execute "$prest_cmd -w $writer @flags $redir $postproc |
                     grep -v 'Wide character'$redirect";
	}