Bio::Root Test
SummaryIncluded librariesPackage variablesSynopsisDescriptionGeneral documentationMethods
Toolbar
WebCvs
Summary
Bio::Root::Test - A common base for all Bioperl test scripts.
Package variables
Privates (from "my" definitions)
$Tester = Test::Builder->new
Included modules
File::Spec
File::Temp qw ( tempdir )
Test::Builder
Test::Builder::Module
Test::Most
Inherit
Test::Builder::Module
Synopsis
  use lib '.'; # (for core package tests only)
use Bio::Root::Test;
test_begin(-tests => 20, -requires_modules => [qw(IO::String XML::Parser)], -requires_networking => 1); my $do_network_tests = test_network(); my $output_debugging = test_debug(); # Bio::Root::Test rewraps Test::Most, so one can carry out tests with # Test::More, Test::Exception, Test::Warn, Test::Deep, Test::Diff syntax SKIP: { # these tests need version 2.6 of Optional::Module to work test_skip(-tests => 10, -requires_module => 'Optional::Module 2.6'); use_ok('Optional::Module'); # 9 other optional tests that need Optional::Module } SKIP: { test_skip(-tests => 10, -requires_networking => 1); # 10 optional tests that require internet access (only makes sense in the # context of a script that doesn't use -requires_networking in the call to # &test_begin) } # in unix terms, we want to test with a file t/data/input_file.txt my $input_file = test_input_file('input_file.txt'); # we want the name of a file we can write to, that will be automatically # deleted when the test script finishes my $output_file = test_output_file(); # we want the name of a directory we can store files in, that will be # automatically deleted when the test script finishes my $output_dir = test_output_dir();
Description
This provides a common base for all BioPerl test scripts. It safely handles the
loading of Test::Most, itself a simple wrapper around several highly used test
modules: Test::More, Test::Exception, Test::Warn, Test::Deep, and Test::Diff. It
also presents an interface to common needs such as skipping all tests if
required modules aren't present or if network tests haven't been enabled. See
test_begin().
In the same way, it allows you to skip just a subset of tests for those same
reasons, in addition to requiring certain executables and environment variables.
See test_skip().
It also has two further methods that let you decide if network tests should be
run, and if debugging information should be printed. See test_network() and
test_debug().
Finally, it presents a consistent way of getting the path to input and output
files. See test_input_file(), test_output_file() and test_output_dir().
Methods
Test::Warn::_canonical_got_warning
No description
Code
Test::Warn::_diag_found_warning
No description
Code
Test::Warn::_cmp_got_to_exp_warning
No description
Code
test_beginDescriptionCode
test_skipDescriptionCode
test_output_fileDescriptionCode
test_output_dirDescriptionCode
test_input_fileDescriptionCode
test_networkDescriptionCode
test_emailDescriptionCode
test_debugDescriptionCode
float_isDescriptionCode
_skip
No description
Code
_check_module
No description
Code
Methods description
test_begincode    nextTop
 Title   : test_begin
Usage : test_begin(-tests => 20);
Function: Begin your test script, setting up the plan (skip all tests, or run
them all)
Returns : True if tests should be run.
Args : -tests => int (REQUIRED, the number of tests that will
be run)
-requires_modules => [] (array ref of module names that are
required; if any don't load, all tests
will be skipped. To specify a required
version of a module, include the version
number after the module name, separated
by a space)
-requires_module => str (as above, but for just one module)
-requires_networking => 1|0 (default 0, if true all tests will be
skipped if network tests haven't been
enabled in Build.PL)
-requires_email => 1 (if true the desired number of tests will
be skipped if either network tests
haven't been enabled in Build.PL or an
email hasn't been entered)
-excludes_os => str (default none, if OS suppied, all tests
will skip if running on that OS (eg.
'mswin'))
-framework => str (default 'Test::Most', the Test module
to load. NB: experimental, avoid using)
Note, supplying -tests => 0 is possible, allowing you to skip all tests in the case that a test script is testing deprecated modules that have yet to be removed from the distribution
test_skipcodeprevnextTop
 Title   : test_skip
Usage : SKIP: {
test_skip(-tests => 10,
-requires_module => 'Optional::Module 2.01');
# 10 tests that need v2.01 of Optional::Module
}
Function: Skip a subset of tests for one of several common reasons: missing one
or more optional modules, network tests haven't been enabled, a
required binary isn't present, or an environmental variable isn't set
Returns : n/a
Args : -tests => int (REQUIRED, the number of tests that are
to be skipped in the event one of the
following options isn't satisfied)
-requires_modules => [] (array ref of module names that are
required; if any don't load, the desired
number of tests will be skipped. To
specify a required version of a module,
include the version number after the
module name, separated by a space)
-requires_module => str (as above, but for just one module)
-requires_executable => Bio::Tools::Run::WrapperBase instance
(checks WrapperBase::executable for the
presence of a binary, skips if absent)
-requires_env => str (checks %ENV for a specific env. variable,
skips if absent)
-excludes_os => str (default none, if OS suppied, desired num
of tests will skip if running on that OS
(eg. 'mswin'))
-requires_networking => 1 (if true the desired number of tests will
be skipped if network tests haven't been
enabled in Build.PL)
-requires_email => 1 (if true the desired number of tests will
be skipped if either network tests
haven't been enabled in Build.PL or an
email hasn't been entered)
test_output_filecodeprevnextTop
 Title   : test_output_file
Usage : my $output_file = test_output_file();
Function: Get the full path of a file suitable for writing to.
When your test script ends, the file will be automatically deleted.
Returns : string (file path)
Args : none
test_output_dircodeprevnextTop
 Title   : test_output_dir
Usage : my $output_dir = test_output_dir();
Function: Get the full path of a directory suitable for storing temporary files
in.
When your test script ends, the directory and its contents will be
automatically deleted.
Returns : string (path)
Args : none
test_input_filecodeprevnextTop
 Title   : test_input_file
Usage : my $input_file = test_input_file();
Function: Get the path of a desired input file stored in the standard location
(currently t/data), but correct for all platforms.
Returns : string (file path)
Args : list of strings (ie. at least the input filename, preceded by the
names of any subdirectories within t/data)
eg. for the file t/data/in.file pass 'in.file', for the file
t/data/subdir/in.file, pass ('subdir', 'in.file')
test_networkcodeprevnextTop
 Title   : test_network
Usage : my $do_network_tests = test_network();
Function: Ask if network tests should be run.
Returns : boolean
Args : none
test_emailcodeprevnextTop
 Title   : test_email
Usage : my $do_network_tests = test_email();
Function: Ask if email address provided
Returns : boolean
Args : none
test_debugcodeprevnextTop
 Title   : test_debug
Usage : my $output_debugging = test_debug();
Function: Ask if debugging information should be output.
Returns : boolean
Args : none
float_iscodeprevnextTop
 Title   : float_is
Usage : float_is($val1, $val2);
Function: test two floating point values for equality
Returns : Boolean based on test (can use in combination with diag)
Args : two scalar values (floating point numbers) (required via prototype)
test message (optional)
Methods code
Test::Warn::_canonical_got_warningdescriptionprevnextTop
sub Test::Warn::_canonical_got_warning {
        my ($called_from, $msg) = @_;
        my $warn_kind = $called_from eq 'Carp' ? 'carped' : ($called_from =~ /Bio::/ ? 'Bioperl' : 'warn');
        
        my $warning;
        if ($warn_kind eq 'Bioperl') {
            ($warning) = $msg =~ /\n--------------------- WARNING ---------------------\nMSG: (.+)\n---------------------------------------------------\n$/m;
            $warning ||= $msg; # shouldn't ever happen
} else { my @warning_stack = split /\n/, $msg; # some stuff of uplevel is included
$warning = $warning_stack[0]; } return {$warn_kind => $warning}; # return only the real message
}
Test::Warn::_diag_found_warningdescriptionprevnextTop
sub Test::Warn::_diag_found_warning {
        foreach (@_) {
            if (ref($_) eq 'HASH') {
                ${$_}{carped} ? $Tester->diag("found carped warning: ${$_}{carped}")
                              : (${$_}{Bioperl} ? $Tester->diag("found Bioperl warning: ${$_}{Bioperl}")
                                 : $Tester->diag("found warning: ${$_}{warn}"));
            } else {
                $Tester->diag( "found warning: $_" );
            }
        }
        $Tester->diag( "didn't find a warning" ) unless @_;
}
Test::Warn::_cmp_got_to_exp_warningdescriptionprevnextTop
sub Test::Warn::_cmp_got_to_exp_warning {
        my ($got_kind, $got_msg) = %{ shift() };
        my ($exp_kind, $exp_msg) = %{ shift() };
        return 0 if ($got_kind eq 'warn') && ($exp_kind eq 'carped');
        
        my $cmp;
        if ($got_kind eq 'Bioperl') {
            $cmp = $got_msg =~ /^\Q$exp_msg\E$/;
        }
        else {
            $cmp = $got_msg =~ /^\Q$exp_msg\E at \S+ line \d+\.?$/;
        }
        
        return $cmp;
    }
}

our @EXPORT = (@Test::Most::EXPORT,
               #@Bio::Root::Test::Warn::EXPORT,
# Test::Warn method wrappers
# BioPerl-specific
qw( test_begin test_skip test_output_file test_output_dir test_input_file test_network test_email test_debug float_is )); our $GLOBAL_FRAMEWORK = 'Test::Most'; our @TEMP_FILES;
}
test_begindescriptionprevnextTop
sub test_begin {
    my ($skip_all, $tests, $framework) = _skip(@_);
    $GLOBAL_FRAMEWORK = $framework;

    if ($framework eq 'Test::Most') {
        # ideally we'd delay loading Test::Most until this point, but see BEGIN
# block
if ($skip_all) { eval "plan skip_all => '$skip_all';"; } elsif (defined $tests && $tests == 0) { eval "plan skip_all => 'All tests are being skipped, probably because the module(s) being tested here are now deprecated';"; } elsif ($tests) { eval "plan tests => $tests;"; } return 1; } # go ahead and add support for other frameworks here
else { die "Only Test::Most is supported at the current time\n"; } return 0;
}
test_skipdescriptionprevnextTop
sub test_skip {
    my ($skip, $tests, $framework) = _skip(@_);
    $tests || die "-tests must be a number greater than 0";

    if ($framework eq 'Test::Most') {
        if ($skip) {
            eval "skip('$skip', $tests);";
        }
    }
    # go ahead and add support for other frameworks here
else { die "Only Test::Most is supported at the current time\n"; }
}
test_output_filedescriptionprevnextTop
sub test_output_file {
    die "test_output_file takes no args\n" if @_;

    # RT 48813
my $tmp = File::Temp->new(); push(@TEMP_FILES, $tmp); close($tmp); # Windows needs this
return $tmp->filename;
}
test_output_dirdescriptionprevnextTop
sub test_output_dir {
    die "test_output_dir takes no args\n" if @_;

    return tempdir(CLEANUP => 1);
}
test_input_filedescriptionprevnextTop
sub test_input_file {
    return File::Spec->catfile('t', 'data', @_);
}
test_networkdescriptionprevnextTop
sub test_network {
    require Module::Build;
    my $build = Module::Build->current();
    return $build->notes('network');
}
test_emaildescriptionprevnextTop
sub test_email {
    require Module::Build;
    my $build = Module::Build->current();
    # this should not be settable unless the network tests work
return $build->notes('email');
}
test_debugdescriptionprevnextTop
sub test_debug {
    return $ENV{'BIOPERLDEBUG'} || 0;
}
float_isdescriptionprevnextTop
sub float_is {
($$;$) {    my ($val1, $val2, $message) = @_;
    # catch any potential undefined values and directly compare
if (!defined $val1 || !defined $val2) { is($val1, $val2 ,$message); } else { is(sprintf("%g",$val1), sprintf("%g",$val2),$message); } } # decide if should skip and generate skip message
}
_skipdescriptionprevnextTop
sub _skip {
    my %args = @_;

    # handle input strictly
my $tests = $args{'-tests'}; #(defined $tests && $tests =~ /^\d+$/) || die "-tests must be supplied and be an int\n";
delete $args{'-tests'}; my $req_mods = $args{'-requires_modules'}; delete $args{'-requires_modules'}; my @req_mods; if ($req_mods) { ref($req_mods) eq 'ARRAY' || die "-requires_modules takes an array ref\n"; @req_mods = @{$req_mods}; } my $req_mod = $args{'-requires_module'}; delete $args{'-requires_module'}; if ($req_mod) { ref($req_mod) && die "-requires_module takes a string\n"; push(@req_mods, $req_mod); } my $req_net = $args{'-requires_networking'}; delete $args{'-requires_networking'}; my $req_email = $args{'-requires_email'}; delete $args{'-requires_email'}; my $req_env = $args{'-requires_env'}; delete $args{'-requires_env'}; # strip any leading $ in case someone passes $FOO instead of 'FOO'
$req_env =~ s{^\$}{} if $req_env; my $req_exe = $args{'-requires_executable'}; delete $args{'-requires_executable'}; if ($req_exe && (!ref($req_exe) || !$req_exe->isa('Bio::Tools::Run::WrapperBase'))) { die "-requires_exe takes an argument of type Bio::Tools::Run::WrapperBase"; } my $os = $args{'-excludes_os'}; delete $args{'-excludes_os'}; my $framework = $args{'-framework'} || $GLOBAL_FRAMEWORK; delete $args{'-framework'}; # catch user mistakes
while (my ($key, $val) = each %args) { die "unknown argument '$key' supplied, did you mistake 'required...' for 'requires...'?\n"; } # test user requirments and return
if ($os) { if ($^O =~ /$os/i) { return ('Not compatible with your Operating System', $tests, $framework); } } foreach my $mod (@req_mods) { my $skip = _check_module($mod); if ($skip) { return ($skip, $tests, $framework); } } if ($req_net && ! test_network()) { return ('Network tests have not been requested', $tests, $framework); } if ($req_email && ! test_email()) { return ('Valid email not provided; required for tests', $tests, $framework); } if ($req_exe) { eval {$req_exe->executable}; if ($@) { my $msg = 'Required executable for '.ref($req_exe).' is not present'; diag($msg); return ($msg, $tests, $framework); } } if ($req_env && !exists $ENV{$req_env}) { my $msg = 'Required environment variable $'.$req_env. ' is not set'; diag($msg); return ($msg, $tests, $framework); } return ('', $tests, $framework);
}
_check_moduledescriptionprevnextTop
sub _check_module {
    my $mod = shift;

    my $desired_version;
    if ($mod =~ /(\S+)\s+(\S+)/) {
        $mod = $1;
        $desired_version = $2;
    }

    eval "require $mod;";

    if ($@) {
	if ($@ =~ /Can't locate/) {
	    return "The optional module $mod (or dependencies thereof) was not installed";
	}
	else {
	    return "The optional module $mod generated the following error:\n $@";
	}
    }
    elsif ($desired_version) {
        no strict 'refs';
        unless (defined ${"${mod}::VERSION"}) {
            return "The optional module $mod didn't have a version, but we want v$desired_version";
        }
        elsif (${"${mod}::VERSION"} < $desired_version) {
            return "The optional module $mod was out of date (wanted v$desired_version)";
        }
    }

    return;
}

1;
}
General documentation
FEEDBACKTop
Mailing ListsTop
User feedback is an integral part of the evolution of this and other
Bioperl modules. Send your comments and suggestions preferably to
the Bioperl mailing list. Your participation is much appreciated.
  bioperl-l@bioperl.org                  - General discussion
http://bioperl.org/wiki/Mailing_lists - About the mailing lists
SupportTop
Please direct usage questions or support issues to the mailing list:
bioperl-l@bioperl.org
rather than to the module maintainer directly. Many experienced and
reponsive experts will be able look at the problem and quickly
address it. Please include a thorough description of the problem
with code and data examples if at all possible.
Reporting BugsTop
Report bugs to the Bioperl bug tracking system to help us keep track
of the bugs and their resolution. Bug reports can be submitted via
the web:
  https://redmine.open-bio.org/projects/bioperl/
AUTHOR - Sendu BalaTop
Email bix@sendu.me.uk
CONTRIBUTORSTop
Chris Fields cjfields at bioperl dot org
APPENDIXTop
The rest of the documentation details each of the object methods.
Internal methods are usually preceded with a _