One of the interesting things about Test::Class is that it loads the perl interpreter once and your modules once. Imagine if you have 30 test programs and each loads Catalyst::Runtime and DBIx::Class. While those are great modules, they take a while to load and reloading them 30 times can be painful. If you convert your 30 test programs to 30 test classes, they only get loaded once and you can get a nice performance boost in your test suite.
Recently, I faced this situation with a bunch of tests which were written as YAML files. Each YAML file had a separate, but nearly identical, test program. These tests took 9.6 minutes to run. I thought about how Test::Class solves this performance issue and I wrote a single test program which found all of the YAML tests and ran them at once. It looked something like this:
use Test::More 'no_plan';
use YAMLTest;
my $builder = Test::More->builder;
foreach my $test (get_tests()) {
my $current = $builder->current_test;
my $expected = YAMLTest->run($test);
is $builder->current_test, $current + $expected, "$test has good t
+est count";
}
By running the tests like this, each module was loaded only once and the total test run dropped from 9.6 minuts to 3.6 minutes. That got me to thinking about a very stupid idea.
Could I do this with regular *.t test programs?
It's a hack, has plenty of problems and breaks in a few cases. It definitely improved some test times, but it does require that tests be written in a way which supports this. Who knows? Maybe someone will find it useful. It was certainly fun to write.
Note that I override a Test::Builder to take out the check for more than one plan. Overridding &Test::More::import is probably a better route.
#!/usr/bin/perl
use strict;
use warnings;
use File::Find;
use Test::More qw/no_plan/;
my @test_files;
find( {
no_chdir => 1,
wanted => sub { push @test_files => $File::Find::name if /\.t
+\z/ }
},
't/'
);
sub slurp {
my $file = shift;
open my $fh, '<', $file or die "Cannot read ($file): $!";
return do { local $/; <$fh> };
}
sub get_package {
my $file = shift;
$file =~ s/\W//g;
return $file;
}
my $code = <<'END_CODE';
{
no warnings 'redefine';
package Test::Builder;
sub plan {
my ( $self, $cmd, $arg ) = @_;
return unless $cmd;
local $Test::Builder::Level = $Test::Builder::Level + 1;
if ( $cmd eq 'no_plan' ) {
$self->no_plan;
}
elsif ( $cmd eq 'skip_all' ) {
return $self->skip_all($arg);
}
elsif ( $cmd eq 'tests' ) {
if ($arg) {
local $Test::Builder::Level = $Test::Builder::Level +
+1;
return $self->expected_tests($arg);
}
elsif ( !defined $arg ) {
$self->croak("Got an undefined number of tests");
}
elsif ( !$arg ) {
$self->croak("You said to run 0 tests");
}
}
else {
my @args = grep { defined } ( $cmd, $arg );
$self->croak("plan() doesn't understand @args");
}
return 1;
}
sub no_header { 1 }
}
END_CODE
my @packages;
foreach my $file (@test_files) {
my $package = get_package($file);
my $tests = slurp($file);
next if $tests =~ /use\s+Config;/; # Why does this break things?
next if $tests =~ /^__(?:DATA|END)__/m;
push @packages => [ $package, $file ];
$code .= <<" END_CODE";
package $package;
sub handler {
$tests;
}
END_CODE
}
$code .= <<'END_CODE';
END {
no warnings 'redefine';
*Test::Builder::no_header = sub { 0 }
}
END_CODE
eval $code;
if ( my $error = $@ ) {
my $file = 'dump.t';
open my $fh, '>', $file or die "Cannot open ($file) for writing: $
+!";
print $fh $code;
close $fh;
BAIL_OUT("Cannot load modules: $error");
}
foreach my $package (@packages) {
ok $package->[0], ">>>>>>>> testing $package->[0]";
$package->[0]->handler;
}
