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