[perl] playing with Test::Trap

In my previous post I was experimenting with Test::Exception. And as I wanted more flexibility reporting the errors (capturing $@) I am now exploring Test::Trap.

Test::Trap has more control about trapping exceptions. It captures them in a object called by default $trap

I have created the next code to test how Test::Trap stores the exceptions and how to retrieve them:

!/usr/bin/env perl


=head1 [progam_name]

 description:

=cut

use strict;
use Bio::EnsEMBL::Utils::Exception qw(throw warning);
use warnings;
use Data::Dumper;
use Test::More;
use Test::Trap;

plan tests => 3;

my $ok;
my $like_ok;

$ok = trap {exception('die1')};

# testing
$like_ok = like($trap->die, qr/cause1/, 'testing exception("die1")');
$like_ok? diag(debug_exception_ok($trap->die,3))
        : diag($ok? "not died but return: $ok" : 'died with: '.$trap->die());

# testing
$like_ok = like($trap->die, qr/cause2/, 'testing exception("die1")');
$like_ok? diag(debug_exception_ok($trap->die,3))
        : diag($ok? "not died but return: $ok" : 'died with: '.$trap->die());

$ok = trap {exception('live')};
like($trap->die, qr/cause1/, 'testing exception("live") ');
$like_ok? diag(debug_exception_ok($trap->die,3))
        : diag($ok? "not died but return: $ok" : 'died with: '.$trap->die());

sub exception {
    my $txt = shift;
    $txt eq 'die1'? throw "cause1" : return $txt;
}

sub debug_exception_ok{
    my $txt = shift;
    my $num = shift;
    #$DB::single=1;
    # add the [ok] to help the output to be taken as ok
    my $msg = '[ok] ' . join ("\n[ok] ",(split "\n",$txt)[0..($num-1)]);
    return $msg;
}

* The first test was ok:

$ok = trap {exception('die1')};

# testing
$like_ok = like($trap->die, qr/cause1/, 'testing exception("die1")');
$like_ok? diag(debug_exception_ok($trap->die,3))
        : diag($ok? "not died but return: $ok" : 'died with: '.$trap->die());

== output ==
ok 1 - testing exception("die1")
# [ok]
# [ok] -------------------- EXCEPTION --------------------
# [ok] MSG: cause1

* the second test, when dying not by the condition tested but by another, then it is a bit over-verbose.

not ok 2 - testing exception("die1")
#   Failed test 'testing exception("die1")'
#   at /nfs/users/nfs_p/pg4/programming/perl/playing_with_test_trap.t line 31.
#                   '
# -------------------- EXCEPTION --------------------
# MSG: cause1
# STACK main::exception /nfs/users/nfs_p/pg4/programming/perl/playing_with_test_trap.t:42
# STACK main::__ANON__[/nfs/users/nfs_p/pg4/programming/perl/playing_with_test_trap.t:23] /nfs/users/nfs_p/pg4/programming/perl/playing_with_test_trap.t:23
# STACK Test::Trap::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap.pm:103] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap.pm:100
# STACK Test::Trap::Builder::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:276] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:276
# STACK (eval) /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap.pm:109
# STACK Test::Trap::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap.pm:112] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap.pm:109
# STACK Test::Trap::Builder::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:276] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:276
# STACK Test::Trap::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap.pm:87] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap.pm:84
# STACK Test::Trap::Builder::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:276] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:276
# STACK Test::Trap::Builder::TempFile::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder/TempFile.pm:33] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder/TempFile.pm:32
# STACK Test::Trap::Builder::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:306] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:305
# STACK Test::Trap::Builder::TempFile::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder/TempFile.pm:33] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder/TempFile.pm:32
# STACK Test::Trap::Builder::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:306] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:305
# STACK Test::Trap::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap.pm:147] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap.pm:146
# STACK Test::Trap::Builder::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:276] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:276
# STACK (eval) /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:88
# STACK Test::Trap::Builder::trap /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:88
# STACK Test::Trap::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap.pm:39] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap.pm:38
# STACK toplevel /nfs/users/nfs_p/pg4/programming/perl/playing_with_test_trap.t:23
# ---------------------------------------------------
# '
#     doesn't match '(?-xism:cause2)'

[until here is the like() output: as it fails it prints the $trap->die. The thing
that I don't like is that the regex tested is at the end of the ouptut]

[now prints the 'cause of death' after the regex tested]
# died with:
# -------------------- EXCEPTION --------------------
# MSG: cause1
# STACK main::exception /nfs/users/nfs_p/pg4/programming/perl/playing_with_test_trap.t:42
# STACK main::__ANON__[/nfs/users/nfs_p/pg4/programming/perl/playing_with_test_trap.t:23] /nfs/users/nfs_p/pg4/programming/perl/playing_with_test_trap.t:23
# STACK Test::Trap::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap.pm:103] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap.pm:100
# STACK Test::Trap::Builder::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:276] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:276
# STACK (eval) /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap.pm:109
# STACK Test::Trap::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap.pm:112] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap.pm:109
# STACK Test::Trap::Builder::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:276] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:276
# STACK Test::Trap::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap.pm:87] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap.pm:84
# STACK Test::Trap::Builder::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:276] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:276
# STACK Test::Trap::Builder::TempFile::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder/TempFile.pm:33] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder/TempFile.pm:32
# STACK Test::Trap::Builder::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:306] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:305
# STACK Test::Trap::Builder::TempFile::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder/TempFile.pm:33] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder/TempFile.pm:32
# STACK Test::Trap::Builder::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:306] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:305
# STACK Test::Trap::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap.pm:147] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap.pm:146
# STACK Test::Trap::Builder::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:276] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:276
# STACK (eval) /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:88
# STACK Test::Trap::Builder::trap /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:88
# STACK Test::Trap::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap.pm:39] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap.pm:38
# STACK toplevel /nfs/users/nfs_p/pg4/programming/perl/playing_with_test_trap.t:23
# ---------------------------------------------------

The problem with this second test with Test::Trap is that the throw() is over-verbose, and gets printed twice if I want to modify the exception output stored in Test::Trap object.

One solution is report the test in a if..else. This is less elegant but do the job:

# testing
if (like($trap->die, qr/cause2/, 'testing exception("die1") for exception cause2') ){
    diag(debug_exception_ok($trap->die,3));
}
elsif($ok){
    diag( "not died but return: $ok");
}

#== output ==
not ok 2 - testing exception("die1") for exception cause2
#   Failed test 'testing exception("die1") for exception cause2'
#   at /nfs/users/nfs_p/pg4/programming/perl/playing_with_test_trap.t line 34.
#                   '
# -------------------- EXCEPTION --------------------
# MSG: cause1
# STACK main::exception /nfs/users/nfs_p/pg4/programming/perl/playing_with_test_trap.t:49
# STACK main::__ANON__[/nfs/users/nfs_p/pg4/programming/perl/playing_with_test_trap.t:22] /nfs/users/nfs_p/pg4/programming/perl/playing_with_test_trap.t:22
# STACK Test::Trap::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap.pm:103] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap.pm:100
# STACK Test::Trap::Builder::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:276] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:276
# STACK (eval) /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap.pm:109
# STACK Test::Trap::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap.pm:112] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap.pm:109
# STACK Test::Trap::Builder::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:276] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:276
# STACK Test::Trap::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap.pm:87] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap.pm:84
# STACK Test::Trap::Builder::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:276] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:276
# STACK Test::Trap::Builder::TempFile::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder/TempFile.pm:33] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder/TempFile.pm:32
# STACK Test::Trap::Builder::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:306] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:305
# STACK Test::Trap::Builder::TempFile::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder/TempFile.pm:33] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder/TempFile.pm:32
# STACK Test::Trap::Builder::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:306] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:305
# STACK Test::Trap::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap.pm:147] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap.pm:146
# STACK Test::Trap::Builder::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:276] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:276
# STACK (eval) /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:88
# STACK Test::Trap::Builder::trap /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap/Builder.pm:88
# STACK Test::Trap::__ANON__[/nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap.pm:39] /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Trap.pm:38
# STACK toplevel /nfs/users/nfs_p/pg4/programming/perl/playing_with_test_trap.t:22
# ---------------------------------------------------
# '
#     doesn't match '(?-xism:cause2)'

* Finally if the tested subrutine does not die, then the like() regular expression for the exception is in void scalar and raise a warning (not elegant)

$ok = trap {exception('live')};
like($trap->die, qr/cause1/, 'testing exception("live") ');
$like_ok? diag(debug_exception_ok($trap->die,3))
: diag($ok? "not died but return: $ok" : '');

#== output==
Use of uninitialized value in pattern match (m//)
at /nfs/users/nfs_p/pg4/programming/perl/playing_with_test_trap.t line 36.
at /nfs/users/nfs_p/pg4/programming/perl/playing_with_test_trap.t line 36
eval '
#line 36 /nfs/users/nfs_p/pg4/programming/perl/playing_with_test_trap.t
$test = $this =~ /$usable_regex/ ? 1 : 0
;' called at /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Builder.pm line 1119
Test::Builder::_regex_ok('Test::Builder=HASH(0x9ba6a0)', 'undef', 'Regexp=SCALAR(0xf39f50)', '=~', 'testing exception("live") ') called at /nfs/users/nfs_p/pg4/local_perl/perllib/Test/Builder.pm line 803
Test::Builder::like('Test::Builder=HASH(0x9ba6a0)', 'undef', 'Regexp=SCALAR(0xf39f50)', 'testing exception("live") ') called at /nfs/users/nfs_p/pg4/local_perl/perllib/Test/More.pm line 416
Test::More::like('undef', 'Regexp=SCALAR(0xf39f50)', 'testing exception("live") ') called at /nfs/users/nfs_p/pg4/programming/perl/playing_with_test_trap.t line 36
not ok 3 - testing exception("live")
# Failed test 'testing exception("live") '
# at /nfs/users/nfs_p/pg4/programming/perl/playing_with_test_trap.t line 36.
# undef
# doesn't match '(?-xism:cause1)'
# not died but return: live

I need the ' : diag($ok? "not died but return: $ok" : ''); ' in order to highligth that the die does not happen as expected and there would be an error in the sub or in the test itself.

To sum up, despite the Test::Trap seems more flexible, Test::Exception just do the job clean and easier with Throws_ok