1#!/usr/bin/perl
2use strict;
3use warnings;
4
5=head1 NAME
6
7build-test-scripts - rebuild t/*.t from t/*.ttmpl
8
9=head1 SYNOPSIS
10
11 t/build-test-scripts
12
13=head1 DESCRIPTION
14
15When run from the root of the IO::Callback distribution, this script rebuilds some of the test files in F<t/> from test template files in the same directory.
16
17Each test template gives rise to one or more test files, with a test file generated for each possible combination of values for the C<vary> directives in the template.
18
19=cut
20
21use autodie;
22use File::Slurp;
23use File::Spec;
24use Template;
25
26our $tt =Template->new({
27    START_TAG => '<<<',
28    END_TAG   => '>>>',
29});
30
31my $dirhandle;
32opendir $dirhandle, "t";
33while ( my $f = readdir $dirhandle ) {
34    next unless $f =~ m{^(.+)\.ttmpl$};
35    my $base_test_name = $1;
36    my $src_filename = File::Spec->catfile("t", $f);
37    my $auto_warning = <<EOF;
38# !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
39#
40# This file was automatically built from $src_filename
41#
42# Do not edit this file, instead edit the template and rebuild by running
43# t/build-test-scripts
44#
45# !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
46EOF
47    my $input = read_file $src_filename;
48    $input =~ s/^((?:#!.*\n)?)/$1 . $auto_warning/e;
49    build_test_scripts($base_test_name, $input, {});
50}
51
52sub build_test_scripts {
53    my ($test_name, $input, $vars) = @_;
54
55    my $vary;
56    my @range;
57    if ($input =~ /\svary!!(\w+)!!([,\w]+)\s/) {
58        $vary = $1;
59        @range = split /,/, $2;
60    } elsif ($input =~ /\svary!!(\w+)\s/) {
61        $vary = $1;
62        @range = ('', $vary);
63    } else {
64        output_test_script($test_name, $input, $vars);
65        return;
66    }
67
68    foreach my $value (@range) {
69        my $copy = $input;
70        $copy =~ s/(\s)vary!!\Q$vary\E(?:!![,\w]+)?(\s)/$1'$value'$2/g;
71        if ($vary eq "taint" and $value eq "taint") {
72            $copy = "#!perl -T\n" . $copy . "\nuse Test::Taint;\ntaint_checking_ok;\n\n";
73        }
74        my $test_name_addition = length $value ? "-$value" : "";
75        build_test_scripts($test_name.$test_name_addition, $copy, { %$vars, $vary => $value });
76    }
77}
78
79sub output_test_script {
80    my ($test_name, $input, $vars) = @_;
81
82    my $outfile = File::Spec->catfile("t", "$test_name.t");
83    $tt->process(\$input, $vars, $outfile) or die "Template $outfile: ".$tt->error;
84}
85
86