t/316_exceptions.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More;
   5
   6 {
   7     package Foo;
   8     use Class::MOP::Exception;
   9
  10     sub new {
  11         bless {}, 'Foo';
  12     }
  13
  14     sub except {
  15         shift;
  16         Class::MOP::Exception->new(@_);
  17     }
  18
  19 }
  20
  21 {
  22     package Bar;
  23     use Class::MOP::Exception;
  24
  25     sub one {
  26         two(@_);
  27     }
  28
  29     sub two {
  30         three(@_);
  31     }
  32
  33     sub three {
  34         Class::MOP::Exception->new(@_);
  35     }
  36 }
  37
  38 {
  39
  40     my $foo = Foo->new;
  41
  42     my $f1 = $foo->except(message => 'bar');
  43     my $f2 = $foo->except();
  44     my $f3 = $foo->except(foo => {1,2});
  45
  46     my $b1 = Bar::one(message => 'bar');
  47     my $b2 = Bar::one();
  48     my $b3 = Bar::one(foo => {1,2});
  49
  50 ################################################## BASIC TESTS ###################
  51
  52     isa_ok($_,'Class::MOP::Exception',"type check") for ($f1,$f2,$f3,$b1,$b2,$b3);
  53     isa_ok($_->stacktrace, 'Devel::StackTrace',"stacktraces are stacktraces") for ($f1,$f2,$f3,$b1,$b2,$b3);
  54     ok(!ref $_->message,"messages are strings") for ($f1,$f2,$f3,$b1,$b2,$b3);
  55     is($_->message,'bar', "correct messages") for ($f1,$b1);
  56     ok(!$_->message,'lack of messages') for ($f2,$f3,$b2,$b3);
  57
  58 ################################################## STRINGIFICATION TESTS ###################
  59
  60     # Verify number of frames dumped
  61     is(scalar @{[split(/\n/,$_)]}, 2, "length of foos") for $f1,$f2,$f3;
  62     is(scalar @{[split(/\n/,$_)]}, 4, "length of bars") for $b1,$b2,$b3;
  63
  64     # Verify initial lines
  65     like([split(/\n/,$_)]->[0], qr{ at t/[0-9]+_[a-zA-Z0-9_-]+\.t line [0-9]+$},"error messages contain correct info") for ($f1,$f2,$f3,$b1,$b2,$b3);
  66
  67     # And the messages of the initial lines
  68     like([split(/\n/,$_)]->[0], qr{^bar at t/}, "messages of f1,b1") for ($f1,$b1);
  69
  70     # And the lack of messages of the other lines
  71     like([split(/\n/,$_)]->[0], qr{^ at t/}, "messages of others") for ($f2,$f3,$b2,$b3);
  72
  73     # And the second lines of foo
  74     like([split(/\n/,$f1)]->[1], qr{^\tFoo::except\(Foo=HASH\(0x[0-9a-f]+\), 'message', 'bar'\) called at t/[0-9]+_[a-zA-Z0-9_-]+\.t line [0-9]+$},"f1[1]");
  75     like([split(/\n/,$f2)]->[1], qr{^\tFoo::except\(Foo=HASH\(0x[0-9a-f]+\)\) called at t/[0-9]+_[a-zA-Z0-9_-]+\.t line [0-9]+$},"f2[1]");
  76     like([split(/\n/,$f3)]->[1], qr{^\tFoo::except\(Foo=HASH\(0x[0-9a-f]+\), 'foo', HASH\(0x[0-9a-f]+\)\) called at t/[0-9]+_[a-zA-Z0-9_-]+\.t line [0-9]+$},"f3[1]");
  77
  78     # And the second lines of bar
  79     like([split(/\n/,$b1)]->[1], qr{^\tBar::three\('message', 'bar'\) called at t/[0-9]+_[a-zA-Z0-9_-]+\.t line [0-9]+$},"b1[1]");
  80     like([split(/\n/,$b2)]->[1], qr{^\tBar::three\(\) called at t/[0-9]+_[a-zA-Z0-9_-]+\.t line [0-9]+$},"b2[1]");
  81     like([split(/\n/,$b3)]->[1], qr{^\tBar::three\('foo', HASH\(0x[0-9a-f]+\)\) called at t/[0-9]+_[a-zA-Z0-9_-]+\.t line [0-9]+$},"b3[1]");
  82
  83     # And the third lines of bar
  84     like([split(/\n/,$b1)]->[2], qr{^\tBar::two\('message', 'bar'\) called at t/[0-9]+_[a-zA-Z0-9_-]+\.t line [0-9]+$},"b1[2]");
  85     like([split(/\n/,$b2)]->[2], qr{^\tBar::two\(\) called at t/[0-9]+_[a-zA-Z0-9_-]+\.t line [0-9]+$},"b2[2]");
  86     like([split(/\n/,$b3)]->[2], qr{^\tBar::two\('foo', HASH\(0x[0-9a-f]+\)\) called at t/[0-9]+_[a-zA-Z0-9_-]+\.t line [0-9]+$},"b3[2]");
  87
  88     # And the fourth lines of bar
  89     like([split(/\n/,$b1)]->[3], qr{^\tBar::one\('message', 'bar'\) called at t/[0-9]+_[a-zA-Z0-9_-]+\.t line [0-9]+$},"b1[3]");
  90     like([split(/\n/,$b2)]->[3], qr{^\tBar::one\(\) called at t/[0-9]+_[a-zA-Z0-9_-]+\.t line [0-9]+$},"b2[3]");
  91     like([split(/\n/,$b3)]->[3], qr{^\tBar::one\('foo', HASH\(0x[0-9a-f]+\)\) called at t/[0-9]+_[a-zA-Z0-9_-]+\.t line [0-9]+$},"b3[3]");
  92 }
  93
  94 done_testing;