view release on metacpan or  search on metacpan

t/40.utils.t  view on Meta::CPAN

#!perl -T
################################################################################
# some tests for helper functions
#
################################################################################

################################################################################

BEGIN{
    use Test::More;
    use Test::NoWarnings;
    use lib 't';
    use BioGrepSkip;
    my ($skip,$msg) = BioGrepSkip::skip_all( );
    plan skip_all => $msg if $skip;
}
plan tests => 30;

use BioGrepTest;

use Scalar::Util qw/tainted/;
use Cwd;

my @paths = ( '', '/', '/usr/local/bin' );

my $sbe = Bio::Grep->new();

my $result = Bio::Grep::SearchResult->new();

# todo make this platform independent
is( $sbe->_cat_path_filename( $paths[0], 't.txt' ), 't.txt', 'concat path' );

my $tainted_word    = 'bla' . substr( cwd, 0, 0 );
my $tainted_integer = '1' . substr( cwd,   0, 0 );
my $tainted_real    = '1.1' . substr( cwd, 0, 0 );

ok( tainted $tainted_word,    $tainted_word . ' tainted' );
ok( tainted $tainted_integer, $tainted_integer . ' tainted' );
ok( tainted $tainted_real,    $tainted_real . ' tainted' );

my $not_tainted_integer = $sbe->is_integer($tainted_integer);
ok( !tainted $not_tainted_integer, $not_tainted_integer . ' not tainted' );
my $not_tainted_word = $sbe->is_word($tainted_word);
ok( !tainted $not_tainted_word, $not_tainted_word . ' not tainted' );

is( $sbe->is_integer('1234'), 1234 );
eval { $sbe->is_integer('1234.5'); };
ok($EVAL_ERROR);
eval { $sbe->is_integer('10 && ls *'); };
ok($EVAL_ERROR);
is( $sbe->is_integer(undef), undef );


is( $sbe->is_word('1234'),           1234 );
is( $sbe->is_word('1234-valid.txt'), '1234-valid.txt' );
is( $sbe->is_word('1234-valid.txt_'), '1234-valid.txt_' );
eval { $sbe->is_word('valid && ls *'); };
ok($EVAL_ERROR);

eval { $sbe->is_arrayref_of_size('',2) };
cmp_ok($EVAL_ERROR, '=~', qr{Argument is not an array reference}, 
    'not an aref' );
eval { $sbe->is_arrayref_of_size({},2) };
cmp_ok($EVAL_ERROR, '=~', qr{Argument is not an array reference}, 
    'not an aref' );
eval { $sbe->is_arrayref_of_size([],2) };
cmp_ok($EVAL_ERROR, '=~', qr{Size of argument is too small}, 
    'Size of argument is too small' );

eval { $sbe->is_arrayref_of_size([ 'a', 'b', 'c' ],2) };
ok(!$EVAL_ERROR, 'ok' ) || diag $EVAL_ERROR;

no warnings;
eval {$sbe->_check_variable()};
cmp_ok($EVAL_ERROR, '=~', qr{Missing arguments: require hash with keys},
    "Exception with missing argument") || diag $EVAL_ERROR;
use warnings;
eval {$sbe->_check_variable( bla => 1 )};
cmp_ok($EVAL_ERROR, '=~', qr{Missing arguments: require hash with keys},
    "Exception with missing argument") || diag $EVAL_ERROR;

eval {$sbe->_check_variable( variable => 'bla',  regex => 'real' )};
cmp_ok($EVAL_ERROR, '=~', qr{Unknown regex},
    "Exception with unknown regex");

eval {$sbe->is_path('C:\My Programs', 'windows') };
ok(!$EVAL_ERROR, 'windows path ok') || diag $EVAL_ERROR;

$sbe=Bio::Grep->new('GUUGle');

ok($sbe->_rnas_match('agcua','agcua'), 'rna matching function');
ok(!$sbe->_rnas_match('agcuag','agcua'), 'rna matching function');
ok($sbe->_rnas_match('uguggu','cgcgau'), 'rna matching function');
ok($sbe->_rnas_match('uguggu','ugcggu'), 'rna matching function');
ok($sbe->_rnas_match('uguggu','cguggu'), 'rna matching function');
ok(!$sbe->_rnas_match('uguggu','cgcguu'), 'rna matching function');

my $tmp = $sbe->settings->tmppath;
$sbe->settings->datapath('data');
$sbe->settings->database('Test_DB_Big.fasta');
$sbe->settings->reverse_complement(1);

my $settings_dump =<<EOT
\$VAR1 = bless( {