package autodbRunTests;
use strict;
# sigh. Test::Deep exports reftype, blessed (and much more), so be careful when importing
# them from Scalar::Util. okay here since we don't use Test::Deep
# use Scalar::Util qw(looks_like_number reftype blessed);
use Getopt::Long;
use Scalar::Util qw(looks_like_number);
use File::Basename qw(fileparse);
use File::Spec;
use Carp;
use Test::More;
use TAP::Harness;
# use TAP::Formatter::Console;
use TAP::Parser::Aggregator;
use Hash::AutoHash::Args;
use Exporter();
our @ISA=qw(Exporter);
our @EXPORT=qw(runtests_main runtests runtests_exact testdir scriptcode);
# runtests_main
# 'main' function to run all tests in subdirectory
sub runtests_main {
my($details,$nested,$basenum);
GetOptions ('details=i'=>\$details,'nested=i'=>\$nested,'basenum=s'=>\$basenum);
$nested=1 if !defined $nested && defined $basenum; # basenum implies nested
$details=1 if !defined $details && $nested; # nested implies details
my($script,$testdir,$skip)=fileparse($0);
my $ok=runtests({testcode=>1,details=>$details,nested=>$nested,basenum=>$basenum});
ok($ok,$script);
done_testing();
}
our $SCRIPT;
sub script {$SCRIPT or (($SCRIPT)=fileparse($0))[0];}
our $SCRIPTCODE;
sub scriptcode {$SCRIPTCODE or (($SCRIPTCODE)=script=~/\.(\w+)\.t$/)[0];}
# runtests
# runs all tests in test directory, with order modified by optional arguments
# if 1st arg is HASH, contains parameters
# details show details of subtests
# nested being run as nested tests, so don't print summary
# exact run exactly and only the given tests in given order
# default unless testcode or testdir set
# testcode scriptname encodes subdirectory in which tests reside
# testdir subdirectory in which tests reside
# with no remaining arguments, tests run in alphabetic order
# remaining argument can be list of 'special' tests to be run in order given or
# hash of test=>count for tests that must be repeated
#
# special tests are spliced into list of all tests in the alphabetically correct
# position
# runtests_exact
# argument is list of tests. these tests are run in given order
# CAUTION: don't import reftype from Scalar::Util because Test::Deep exports it with prototype
sub runtests {_runtests('HASH' eq Scalar::Util::reftype($_[0])? shift: {},\@_);}
sub runtests_exact {
my $params='HASH' eq Scalar::Util::reftype($_[0])? shift: {};
$params->{exact}=1;
_runtests($params,\@_);
}
sub testdir {
my($params)=@_;
$params=new Hash::AutoHash::Args $params;
my($script,$testdir,$skip)=fileparse($0);
if ($params->testcode) {
# use word after digits (cases like autodb.051.Table.t) or
# script basename (cases like autodb.099.docs.t)
my $testcode;
($testcode)=$script=~/\d+\.([[:upper:]]\w*)\.t$/ or ($testcode)=$script=~/^(.*)\.t$/;
$testdir=$testdir.$testcode.'/';
} elsif ($params->testdir) {
$testdir=$testdir.$params->testdir;
$testdir.='/' unless $testdir=~/\/$/;
} else {
$params->exact(1);
}
$testdir;
}
sub _runtests {
my($params,$files_or_array)=@_;
$params=new Hash::AutoHash::Args $params;
my($script,$testdir,$skip)=fileparse($0);
if ($params->testcode) {
# use word after digits (cases like autodb.051.Table.t) or
# script basename (cases like autodb.099.docs.t)
my $testcode;
($testcode)=$script=~/\d+\.([[:upper:]]\w*)\.t$/ or ($testcode)=$script=~/^(.*)\.t$/;
$testdir=$testdir.$testcode.'/';
} elsif ($params->testdir) {
$testdir=$testdir.$params->testdir;
$testdir.='/' unless $testdir=~/\/$/;
} else {
$params->exact(1);
}
my(@dirfiles,@testfiles);
my $i=0; # index into @testfiles, preserved across loops
my %seen; # holds files added to @out from input lists
if ($params->exact) { # use testfiles as given
@testfiles=@{$files_or_array};
} else {
opendir(DIR,$testdir) or confess "Cannot read test directory $testdir: $!";
@dirfiles=sort grep /^[^.].*\.t$/,readdir DIR;
closedir DIR;
if (@$files_or_array) {
$files_or_array=[$files_or_array] unless ('ARRAY' eq ref $files_or_array->[0]);
for my $files (@$files_or_array) {
if (looks_like_number($files->[1])) { # argument looks like hash of test=>count
my %repeat=@$files;
push(@testfiles,map {($_) x ($repeat{$_}||1)} keys %repeat);
@seen{keys %repeat}=(1)x(keys %repeat);
} else { # splice given files into @testfiles
my @files=map {/^(\S+)/} @$files; # strip off any args
@seen{@files}=(1)x@files;
for(; $i<@dirfiles; $i++) { # 1st loop gets files before specials
last if $seen{$dirfiles[$i]};
push(@testfiles,$dirfiles[$i]);
}
push(@testfiles,@$files); # add in given files
for(; $i<@dirfiles; $i++) { # skip dirfiles we've already processed
last unless $seen{$dirfiles[$i]};
}
}
}
}
# add in files after last given ones (or all files if $files_or_array empty
push(@testfiles,@dirfiles[$i..$#dirfiles]);
}
# remove any testfiles in 'skip'
if (my $skip=$params->skip) { # can be single test or ARRAY
$skip=[$skip] unless ref $skip;
$skip={map {$_=>$_} @$skip};
@testfiles=grep {!$skip->{$_}} @testfiles;
}
# NG 09-03-19: Test::Harness no longer allows repeated running of same tests w/o
# jumping through some hoops. sigh...
# $i and [] in 'map' below are the hoops
my $i=0;
my $basenum=$params->basenum;
$basenum.='.' if defined $basenum;
@testfiles=map {File::Spec->catfile($testdir,$_)} @testfiles;
@testfiles=map {[$_,$basenum.sprintf("%03d",++$i)." $_"]} @testfiles;
# switches=>undef is probably unnecessary
# verbosity=>0 is normal, -3 is silent (only prints failures)
my $harness=new TAP::Harness
({switches=>undef,lib=>['blib/lib','blib/arch'],verbosity=>$params->details? 0: -3,
parser_class=>'t::tap',
});
# NG 10-01-05: trying to make nested tests work better
unless ($params->nested) { # do it the old way
$harness->runtests(@testfiles)->all_passed;
} else {
# my $formatter = TAP::Formatter::Console->new;
my $agg=new TAP::Parser::Aggregator;
$agg->start();
$harness->aggregate_tests($agg,(@testfiles));
$agg->stop();
$agg->all_passed;
# $formatter->summary($agg);
}
# The calling program needs to do the 'ok' and 'done_testing', to keep
# plans in synch and Test::More happy
# ok($result,$script);
# done_testing();
# I'm undecided as to whether tests that show details should do a final 'ok'
# (code below turns this off - should replace 2 lines above)
# this is needed for tests to be used recursively.
# but when used as top level tests, it causes a confusing final '1..1' message
# I don't see a way to make this decision automatically...
#
# unless ($params->details) {
# require Test::More;
# import Test::More;
# ok($result,$script);
# done_testing();
# }
}
1;