Skip to content

Commit

Permalink
run this in an eval block; tests are still failing in bioperl-run, bu…
Browse files Browse the repository at this point in the history 
…t possibly do to misuse of executable()
  • Loading branch information
Chris Fields committed May 19, 2011
1 parent 022b7e7 commit 2e79747
Showing 1 changed file with 46 additions and 44 deletions.
90 changes: 46 additions & 44 deletions Bio/Root/Test.pm
View file
@@ -1,7 +1,7 @@
#
# BioPerl module for Bio::Root::Test
#
# Please direct questions and support issues to <bioperl-l@bioperl.org>
# Please direct questions and support issues to <bioperl-l@bioperl.org>
#
# Cared for by Sendu Bala <bix@sendu.me.uk>
#
Expand Down Expand Up @@ -86,15 +86,15 @@ 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
=head2 Support
=head2 Support
Please direct usage questions or support issues to the mailing list:
I<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
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.
=head2 Reporting Bugs
Expand Down Expand Up @@ -128,7 +128,7 @@ use Exporter qw(import);
BEGIN {
# For prototyping reasons, we have to load Test::More's methods now, even
# though theoretically in future the user may use a different Test framework

# We want to load Test::More, Test::Exception and Test::Warn. Preferably the
# users own versions, but if they don't have them, the ones in t/lib.
# However, this module is in t/lib so t/lib is already in @INC so Test::* in
Expand All @@ -143,7 +143,7 @@ BEGIN {
eval "use Test::More;
use Test::Exception;";
die "$@\n" if $@;

# now that the users' Test::Warn has been loaded if they had it, we can
# use Bio::Root::TestWarn
eval "use Bio::Root::Test::Warn;";
Expand All @@ -162,17 +162,17 @@ our @EXPORT = qw(ok use_ok require_ok
can_ok isa_ok
diag
BAIL_OUT
dies_ok
lives_ok
throws_ok
lives_and
warning_is
warnings_are
warning_like
warnings_like
test_begin
test_skip
test_output_file
Expand Down Expand Up @@ -219,7 +219,7 @@ our @TEMP_FILES;
'mswin'))
-framework => str (default 'Test::More', 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
Expand All @@ -229,11 +229,11 @@ our @TEMP_FILES;
sub test_begin {
my ($skip_all, $tests, $framework) = _skip(@_);
$GLOBAL_FRAMEWORK = $framework;

if ($framework eq 'Test::More') {
# ideally we'd delay loading Test::More until this point, but see BEGIN
# block

if ($skip_all) {
eval "plan skip_all => '$skip_all';";
}
Expand All @@ -243,14 +243,14 @@ sub test_begin {
elsif ($tests) {
eval "plan tests => $tests;";
}

return 1;
}
# go ahead and add support for other frameworks here
else {
die "Only Test::More is supported at the current time\n";
}

return 0;
}

Expand All @@ -260,7 +260,6 @@ sub test_begin {
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
Expand Down Expand Up @@ -298,7 +297,7 @@ sub test_begin {
sub test_skip {
my ($skip, $tests, $framework) = _skip(@_);
$tests || die "-tests must be a number greater than 0";

if ($framework eq 'Test::More') {
if ($skip) {
eval "skip('$skip', $tests);";
Expand All @@ -323,7 +322,7 @@ sub test_skip {

sub test_output_file {
die "test_output_file takes no args\n" if @_;

# RT 48813
my $tmp = File::Temp->new();
push(@TEMP_FILES, $tmp);
Expand All @@ -346,7 +345,7 @@ sub test_output_file {

sub test_output_dir {
die "test_output_dir takes no args\n" if @_;

return tempdir(CLEANUP => 1);
}

Expand Down Expand Up @@ -439,12 +438,12 @@ sub float_is ($$;$) {
# decide if should skip and generate skip message
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;
Expand All @@ -458,51 +457,51 @@ sub _skip {
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;
$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);
return ($skip, $tests, $framework);
}
}

if ($req_net && ! test_network()) {
return ('Network tests have not been requested', $tests, $framework);
}
Expand All @@ -511,32 +510,35 @@ sub _skip {
return ('Valid email not provided; required for tests', $tests, $framework);
}

if ($req_exe && !$req_exe->executable) {
my $msg = 'Required executable for '.ref($req_exe).' is not present';
diag($msg);
return ($msg, $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);
}

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";
Expand All @@ -554,8 +556,8 @@ sub _check_module {
return "The optional module $mod was out of date (wanted v$desired_version)";
}
}

return;
}

1;

0 comments on commit 2e79747

Please sign in to comment.