Showing posts with label perl CPAN. Show all posts
Showing posts with label perl CPAN. Show all posts

Tuesday, 9 October 2012

DBD::myql 4.022 not passing test 80procs.t and how to FIX it

I failed to install DBD::mysql. This time I had the dev files and everything.
FAIL Installing DBD::mysql failed. See /home/pmg/.cpanm/build.log for details. $ cpanm DBD::mysql [...] DBD::mysql::db do failed: alter routine command denied to user ''@'localhost' for routine 'test.testproc' at t/80procs.t line 41.
Looking at this line of code:
my $drop_proc= "DROP PROCEDURE IF EXISTS testproc";

ok $dbh->do($drop_proc);
And looking at my mysql db table I can see that there is no privileges for alter or execute procedures
mysql> select * from db\G
                 Host: localhost
                    Db: test
                  User:
           Select_priv: Y
           Insert_priv: Y
           Update_priv: Y
           Delete_priv: Y
           Create_priv: Y
             Drop_priv: Y
            Grant_priv: N
       References_priv: Y
            Index_priv: Y
            Alter_priv: Y
 Create_tmp_table_priv: Y
      Lock_tables_priv: Y
      Create_view_priv: Y
        Show_view_priv: Y
   Create_routine_priv: Y
    Alter_routine_priv: N  # <<====
          Execute_priv: N  # <<====
            Event_priv: Y
          Trigger_priv: Y


        mysql> show grants for ''@localhost;
        +-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
        | Grants for @localhost                                                                                                                                                                                       |
        +-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
        | GRANT USAGE ON *.* TO ''@'localhost'                                                                                                                                                                        |
        | GRANT SELECT, INSERT, UPDATE, DELETE, CREATE, DROP, REFERENCES, INDEX, ALTER, CREATE TEMPORARY TABLES, LOCK TABLES, CREATE VIEW, SHOW VIEW, CREATE ROUTINE, EVENT, TRIGGER ON `test`.* TO ''@'localhost'    |
        | GRANT SELECT, INSERT, UPDATE, DELETE, CREATE, DROP, REFERENCES, INDEX, ALTER, CREATE TEMPORARY TABLES, LOCK TABLES, CREATE VIEW, SHOW VIEW, CREATE ROUTINE, EVENT, TRIGGER ON `test\_%`.* TO ''@'localhost' |
        +-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
        4 rows in set (0.00 sec)

FIXING the problem: Add permision to anyone from localhost to test

 mysql> grant ALL on test.* to ''@'localhost';
  mysql> show grants for ''@localhost;
  +-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
  | Grants for @localhost                                                                                                                                                                                       |
  +-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
  | GRANT USAGE ON *.* TO ''@'localhost'                                                                                                                                                                        |
  | GRANT ALL PRIVILEGES ON `test`.* TO ''@'localhost'                                                                                                                                                          |
  | GRANT SELECT, INSERT, UPDATE, DELETE, CREATE, DROP, REFERENCES, INDEX, ALTER, CREATE TEMPORARY TABLES, LOCK TABLES, CREATE VIEW, SHOW VIEW, CREATE ROUTINE, EVENT, TRIGGER ON `test\_%`.* TO ''@'localhost' |
  +-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
  4 rows in set (0.00 sec)
  mysql> select * from db\G
  *************************** 1. row ***************************
                   Host: localhost
                     Db: test
                   User:
            Select_priv: Y
            Insert_priv: Y
            Update_priv: Y
            Delete_priv: Y
            Create_priv: Y
              Drop_priv: Y
             Grant_priv: N
        References_priv: Y
             Index_priv: Y
             Alter_priv: Y
  Create_tmp_table_priv: Y
       Lock_tables_priv: Y
       Create_view_priv: Y
         Show_view_priv: Y
    Create_routine_priv: Y
     Alter_routine_priv: Y  ## <<<<==== OK
           Execute_priv: Y  ## <<<<==== OK
             Event_priv: Y
           Trigger_priv: Y


After this change I installed DBD::mysql and all test passed.

Tuesday, 1 June 2010

[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

[perl] playing with Test::Exception

More about testing: handling exceptions


Today I was updating some tests for my modules and I needed to test the exception handling. I was going to use 'eval{..}or do{..}' but decided to go for Try::Tiny, but once I entered in the path of using CPAN modules I decided to give a try (not pun intended) to Test::Exception.

I have read about some people complaining about Test::Exception using prototypes and talking about this would lead to some unexpected behaviors in very uncommon situations. The author of Test::Exception also implemented the methods without prototypes (they are less attractive) but I don't know if not using the prototyped methods are free of the edge cases errors. Any way chromatic explained in this blog entry how the prototyped methods in Test::Exception works.

Here I am playing with the test to see how can I handle the output of the tests:

* First try

Created a basic test "test_Test_Exception.t" to see if my method die

use strict;
#use warnings;
#use Data::Dumper;
use Test::More;
use Test::Exception;

plan tests => 3;

my $ok;


$ok = dies_ok (sub {die1()}
, 'testing die1'
);

$ok = dies_ok (sub {die2()}
, 'testing die2'
);
$ok = dies_ok (sub {live()}
, 'testing live expecting die1'
);

sub die1 {
die "cause1";
}

sub die2 {
die "cause2"
}

sub live {
return 1;
}

== result ==

> perl test_Test_Exception.t
1..3
ok 1 - testing die1
ok 2 - testing die2
not ok 3 - testing live expecting die1
# Failed test 'testing live expecting die1'
# at /nfs/users/nfs_p/pg4/programming/perl/test_Test_Exception.t line 29.

This is nice, if you expect something to die but doesn't, it tells you that.


* Second try

What would happen when you have some exceptions in a method and you want to test them and you want to be sure that they are the correct ones.

You have throws_ok and you test for a regex of the output
#
## trying throws_ok
#
$ok = throws_ok (sub {die1()}
, qr/cause1/
, 'testing die1'
);

$ok = throws_ok (sub {die2()}
, qr/cause1/
, 'testing die2 to see if die of cause 1'
);
$ok = throws_ok (sub {live()}
, qr/cause1/
, 'testing live expecting die1'
);


== result ==
> perl test_Test_Exception.t
1..3
ok 1 - testing die1
not ok 2 - testing die2 to see if die of cause 1
# Failed test 'testing die2 to see if die of cause 1'
# at /nfs/users/nfs_p/pg4/programming/perl/playing_with_test_exception.pl line 41.
# expecting: Regexp ((?-xism:cause1))
# found: cause2 at /nfs/users/nfs_p/pg4/programming/perl/playing_with_test_exception.pl line 86.
not ok 3 - testing live expecting die1
# Failed test 'testing live expecting die1'
# at /nfs/users/nfs_p/pg4/programming/perl/playing_with_test_exception.pl line 45.
# expecting: Regexp ((?-xism:cause1))
# found: normal exit

This is even better: test2 now fails if the exception text is not the expected one.


* third try
A more complicated case:
I have a subrutine, and I test for one of the arguments but I tested for lowercase 'a' instead uppercase 'A'. But this subrutine has another exception and dies when second argument is 'B'

#
## more about throws_ok
#

# testing an exception but obtaining other
# error in the method: testing a instead A
# - it should die when passing 'A' but does not die because that
$ok1 = dies_ok (sub {die3('A', 'B')}
, 'testing faulty method die3 with dies_ok: it should die BUT does it because another reason'
);

$ok2 = throws_ok (sub {die3('A', 'B')}
, qr/because A/
, 'testing faulty method die3 with throws_ok it should die BUT does it because another reason'
);

# testing the other exception
$ok3 = throws_ok (sub {die3( undef,'B')}
, qr/because B/
, 'testing faulty method die3 with throws_ok for another exception that works ok'
);

# testing exception but an error in the test (wrong argument so it does not die)
$ok4 = dies_ok (sub {die3( undef)}
, 'testing faulty test for die3: should die but it doesn\'t'
);


$ok5 = throws_ok (sub {die3( undef)}
, qr/because A/
, 'testing faulty test for die3: should die but it doesn\'t'
);


sub die3 {

my $in = shift;
my $out = shift;

# [error] testing if $in eq A but testing eq 'a' instead
die "die because A" if $in eq 'a';

# ups sometimes something else goes wrong
if ( $out eq "B" ) {
die "die because BLAH";
}

return "live";
}


== results ==

# with dies_ok wrong result, it is happy with the death (but by the wrong motives :-():
ok 1 - testing faulty method die3 with dies_ok: it should die BUT does it because another reason

# but the expected result (failed) with throws_ok
not ok 2 - testing faulty method die3 with throws_ok it should die BUT does it because another reason
# Failed test 'testing faulty method die3 with throws_ok it should die BUT does it because another reason'
# at /nfs/users/nfs_p/pg4/programming/perl/test_Test_Exception.t line 61.
# expecting: Regexp ((?-xism:because A))
# found: die because BLAH at /nfs/users/nfs_p/pg4/programming/perl/test_Test_Exception.t line 100.

#
ok 3 - testing faulty method die3 with throws_ok for another exception that works ok

# it fails because not die
not ok 4 - testing faulty test with dies_ok for die3: should die but it doesn't
# Failed test 'testing faulty test for die3: should die but it doesn't'
# at /nfs/users/nfs_p/pg4/programming/perl/test_Test_Exception.t line 73.

# It fails because does not die at all and tell you that: "found: normal exit"
not ok 5 - testing faulty test with throws_ok for die3: should die but it doesn't
# Failed test 'testing faulty test for die3: should die but it doesn't'
# at /nfs/users/nfs_p/pg4/programming/perl/test_Test_Exception.t line 77.
# expecting: Regexp ((?-xism:because A))
# found: normal exit

The throws_ok is more informative and prevents to think that your test failed as expected when indeed was not "as expected" but because another reason.



This is fine, but if I want double check the output messages for the exceptions when debugging, I need to add the 'and diag($@)' or if I want to see if it failed because other exception or because it didn't die I need to do the following:

my $ok = throws_ok( sub {...}, qr/check/, 'test desc') 
          or do {$@? diag("FAILED:\n Wrong exception.") 
                   : diag("FAILED:\n it was suppose to die")
                };
 diag("Exception_ok:\n". lines($@,3)) if $ok; 

 sub lines{
   my $txt = shift;
   my $num = shift;
   # 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;
 }

And then you would have output like this for failed tests:

not ok 5 - \#Should die: parse_tab_file_to_AoH without headers array ref:
# Failed test '\#Should die: parse_tab_file_to_AoH without headers array ref: '
# at PMGBase.t line 69.
# expecting: Regexp ((?-xism:but not \$headers))
# found: normal exit
# FAILED:
# it was suppose to die
not ok 6 - \#Should die: parse_tab_file_to_AoH without headers array ref:
# Failed test '\#Should die: parse_tab_file_to_AoH without headers array ref: '
# at PMGBase.t line 76.
# expecting: Regexp ((?-xism:but no \$headers))
# found:
# -------------------- EXCEPTION --------------------
# MSG: # [FATAL] sorry but 'parse_tab_file()' called with type 'AoH' but not $headers_aref provided
#
# STACK PMGBase::_throw ..//PMGBase.pm:498
# STACK PMGBase::parse_tab_file ..//PMGBase.pm:612
# STACK PMGBase::parse_tab_file_to_AoH ..//PMGBase.pm:561
# STACK Test::Exception::throws_ok PMGBase.t:73
# STACK toplevel PMGBase.t:76
# ---------------------------------------------------
# FAILED:
# Wrong exception.

And some debug info for the ones ok:

ok 7 - \#Should die: parse_tab_file_to_AoH without headers array ref:
# Exception_ok:
# [ok]
# [ok] -------------------- EXCEPTION --------------------
# [ok] MSG: # [FATAL] sorry but 'parse_tab_file()' called with type 'AoH' but not $headers_aref provided

ok 9 - \#Should die: parse_tab_file_to_AoH with wrong number of header columns:
# Exception_ok:
# [ok]
# [ok] -------------------- EXCEPTION --------------------
# [ok] MSG: line 2 has different number of columns that the header


Next step is to explore the Test::Trap that seems that have better layers for handling and reporting the exceptions. But at the moment if you want a simple ok/fail for exceptions Test::Exception is very handy.