27
27
my $do_network_tests = test_network();
28
28
my $output_debugging = test_debug();
30
# carry out tests with Test::More, Test::Exception and Test::Warn syntax
30
# Bio::Root::Test rewraps Test::Most, so one can carry out tests with
31
# Test::More, Test::Exception, Test::Warn, Test::Deep, Test::Diff syntax
33
34
# these tests need version 2.6 of Optional::Module to work
61
62
This provides a common base for all BioPerl test scripts. It safely handles the
62
loading of Test::More, Test::Exception and Test::Warn (actually, a subclass
63
compatible with Bioperl warnings) prior to tests being run. It also presents an
64
interface to common needs such as skipping all tests if required modules aren't
65
present or if network tests haven't been enabled. See test_begin().
63
loading of Test::Most, itself a simple wrapper around several highly used test
64
modules: Test::More, Test::Exception, Test::Warn, Test::Deep, and Test::Diff. It
65
also presents an interface to common needs such as skipping all tests if
66
required modules aren't present or if network tests haven't been enabled. See
67
69
In the same way, it allows you to skip just a subset of tests for those same
68
70
reasons, in addition to requiring certain executables and environment variables.
86
88
bioperl-l@bioperl.org - General discussion
87
89
http://bioperl.org/wiki/Mailing_lists - About the mailing lists
91
93
Please direct usage questions or support issues to the mailing list:
93
95
I<bioperl-l@bioperl.org>
95
rather than to the module maintainer directly. Many experienced and
96
reponsive experts will be able look at the problem and quickly
97
address it. Please include a thorough description of the problem
97
rather than to the module maintainer directly. Many experienced and
98
reponsive experts will be able look at the problem and quickly
99
address it. Please include a thorough description of the problem
98
100
with code and data examples if at all possible.
100
102
=head2 Reporting Bugs
130
# According to Ovid, 'use base' can override signal handling, so use
131
# old-fashioned way. This should be a Test::Builder::Module subclass
132
# for consistency (as are any Test modules)
135
use Test::Builder::Module;
124
136
use File::Temp qw(tempdir);
126
use Exporter qw(import);
129
# For prototyping reasons, we have to load Test::More's methods now, even
130
# though theoretically in future the user may use a different Test framework
132
# We want to load Test::More, Test::Exception and Test::Warn. Preferably the
133
# users own versions, but if they don't have them, the ones in t/lib.
134
# However, this module is in t/lib so t/lib is already in @INC so Test::* in
135
# t/lib will be used first, which we don't want: get rid of t/lib in @INC
137
eval { require Test::More;
138
require Test::Exception;
139
require Test::Warn; };
141
eval "use lib 't/lib';";
143
eval "use Test::More;
144
use Test::Exception;";
147
# now that the users' Test::Warn has been loaded if they had it, we can
148
# use Bio::Root::TestWarn
149
eval "use Bio::Root::Test::Warn;";
153
# re-export Test::More, Test::Exception and Test::Warn methods and export our own
154
our @EXPORT = qw(ok use_ok require_ok
155
is isnt like unlike is_deeply
159
eq_array eq_hash eq_set
187
if (Test::More->can('done_testing')) {
188
push @EXPORT, 'done_testing';
191
our $GLOBAL_FRAMEWORK = 'Test::More';
139
our @ISA = qw(Test::Builder::Module);
141
# TODO: Evil magic ahead; can we clean this up?
144
my $Tester = Test::Builder->new;
146
no warnings 'redefine';
147
sub Test::Warn::_canonical_got_warning {
148
my ($called_from, $msg) = @_;
149
my $warn_kind = $called_from eq 'Carp' ? 'carped' : ($called_from =~ /Bio::/ ? 'Bioperl' : 'warn');
152
if ($warn_kind eq 'Bioperl') {
153
($warning) = $msg =~ /\n--------------------- WARNING ---------------------\nMSG: (.+)\n---------------------------------------------------\n$/m;
154
$warning ||= $msg; # shouldn't ever happen
157
my @warning_stack = split /\n/, $msg; # some stuff of uplevel is included
158
$warning = $warning_stack[0];
161
return {$warn_kind => $warning}; # return only the real message
164
sub Test::Warn::_diag_found_warning {
166
if (ref($_) eq 'HASH') {
167
${$_}{carped} ? $Tester->diag("found carped warning: ${$_}{carped}")
168
: (${$_}{Bioperl} ? $Tester->diag("found Bioperl warning: ${$_}{Bioperl}")
169
: $Tester->diag("found warning: ${$_}{warn}"));
171
$Tester->diag( "found warning: $_" );
174
$Tester->diag( "didn't find a warning" ) unless @_;
177
sub Test::Warn::_cmp_got_to_exp_warning {
178
my ($got_kind, $got_msg) = %{ shift() };
179
my ($exp_kind, $exp_msg) = %{ shift() };
180
return 0 if ($got_kind eq 'warn') && ($exp_kind eq 'carped');
183
if ($got_kind eq 'Bioperl') {
184
$cmp = $got_msg =~ /^\Q$exp_msg\E$/;
187
$cmp = $got_msg =~ /^\Q$exp_msg\E at \S+ line \d+\.?$/;
194
our @EXPORT = (@Test::Most::EXPORT,
195
#@Bio::Root::Test::Warn::EXPORT,
196
# Test::Warn method wrappers
211
our $GLOBAL_FRAMEWORK = 'Test::Most';
194
214
=head2 test_begin
217
237
-excludes_os => str (default none, if OS suppied, all tests
218
238
will skip if running on that OS (eg.
220
-framework => str (default 'Test::More', the Test module
240
-framework => str (default 'Test::Most', the Test module
221
241
to load. NB: experimental, avoid using)
223
243
Note, supplying -tests => 0 is possible, allowing you to skip all
224
244
tests in the case that a test script is testing deprecated modules
225
245
that have yet to be removed from the distribution
230
250
my ($skip_all, $tests, $framework) = _skip(@_);
231
251
$GLOBAL_FRAMEWORK = $framework;
233
if ($framework eq 'Test::More') {
234
# ideally we'd delay loading Test::More until this point, but see BEGIN
253
if ($framework eq 'Test::Most') {
254
# ideally we'd delay loading Test::Most until this point, but see BEGIN
238
258
eval "plan skip_all => '$skip_all';";
299
318
my ($skip, $tests, $framework) = _skip(@_);
300
319
$tests || die "-tests must be a number greater than 0";
302
if ($framework eq 'Test::More') {
321
if ($framework eq 'Test::Most') {
304
323
eval "skip('$skip', $tests);";
307
326
# go ahead and add support for other frameworks here
309
die "Only Test::More is supported at the current time\n";
328
die "Only Test::Most is supported at the current time\n";
458
477
ref($req_mod) && die "-requires_module takes a string\n";
459
478
push(@req_mods, $req_mod);
462
481
my $req_net = $args{'-requires_networking'};
463
482
delete $args{'-requires_networking'};
465
484
my $req_email = $args{'-requires_email'};
466
485
delete $args{'-requires_email'};
468
487
my $req_env = $args{'-requires_env'};
469
488
delete $args{'-requires_env'};
471
490
# strip any leading $ in case someone passes $FOO instead of 'FOO'
472
$req_env =~ s{^\$}{} if $req_env;
491
$req_env =~ s{^\$}{} if $req_env;
474
493
my $req_exe = $args{'-requires_executable'};
475
494
delete $args{'-requires_executable'};
477
496
if ($req_exe && (!ref($req_exe) || !$req_exe->isa('Bio::Tools::Run::WrapperBase'))) {
478
497
die "-requires_exe takes an argument of type Bio::Tools::Run::WrapperBase";
481
500
my $os = $args{'-excludes_os'};
482
501
delete $args{'-excludes_os'};
484
503
my $framework = $args{'-framework'} || $GLOBAL_FRAMEWORK;
485
504
delete $args{'-framework'};
487
506
# catch user mistakes
488
507
while (my ($key, $val) = each %args) {
489
508
die "unknown argument '$key' supplied, did you mistake 'required...' for 'requires...'?\n";
492
511
# test user requirments and return
494
513
if ($^O =~ /$os/i) {
495
514
return ('Not compatible with your Operating System', $tests, $framework);
499
518
foreach my $mod (@req_mods) {
500
519
my $skip = _check_module($mod);
502
return ($skip, $tests, $framework);
521
return ($skip, $tests, $framework);
506
525
if ($req_net && ! test_network()) {
507
526
return ('Network tests have not been requested', $tests, $framework);
511
530
return ('Valid email not provided; required for tests', $tests, $framework);
514
if ($req_exe && !$req_exe->executable) {
515
my $msg = 'Required executable for '.ref($req_exe).' is not present';
517
return ($msg, $tests, $framework);
534
eval {$req_exe->executable};
536
my $msg = 'Required executable for '.ref($req_exe).' is not present';
538
return ($msg, $tests, $framework);
520
542
if ($req_env && !exists $ENV{$req_env}) {
521
543
my $msg = 'Required environment variable $'.$req_env. ' is not set';
523
545
return ($msg, $tests, $framework);
526
548
return ('', $tests, $framework);
529
551
sub _check_module {
532
554
my $desired_version;
533
555
if ($mod =~ /(\S+)\s+(\S+)/) {
535
557
$desired_version = $2;
538
560
eval "require $mod;";
541
563
if ($@ =~ /Can't locate/) {
542
564
return "The optional module $mod (or dependencies thereof) was not installed";
added
removed
Bio/Root/Test.pm
