| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Test::Unit::Assertion::Exception; | 
| 2 |  |  |  |  |  |  |  | 
| 3 | 1 |  |  | 1 |  | 6 | use strict; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 42 |  | 
| 4 | 1 |  |  | 1 |  | 6 | use base qw/Test::Unit::Assertion/; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 107 |  | 
| 5 |  |  |  |  |  |  |  | 
| 6 | 1 |  |  | 1 |  | 7 | use Carp; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 90 |  | 
| 7 | 1 |  |  | 1 |  | 6 | use Error qw/:try/; | 
|  | 1 |  |  |  |  | 3 |  | 
|  | 1 |  |  |  |  | 8 |  | 
| 8 | 1 |  |  | 1 |  | 187 | use Test::Unit::Debug qw(debug); | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 309 |  | 
| 9 |  |  |  |  |  |  |  | 
| 10 |  |  |  |  |  |  | my $deparser; | 
| 11 |  |  |  |  |  |  |  | 
| 12 |  |  |  |  |  |  | sub new { | 
| 13 | 4 |  |  | 4 | 1 | 8 | my $class = shift; | 
| 14 | 4 |  |  |  |  | 7 | my $exception_class = shift; | 
| 15 | 4 | 50 |  |  |  | 13 | croak "$class\::new needs an exception class" unless $exception_class; | 
| 16 | 4 |  |  |  |  | 19 | bless \$exception_class => $class; | 
| 17 |  |  |  |  |  |  | } | 
| 18 |  |  |  |  |  |  |  | 
| 19 |  |  |  |  |  |  | sub do_assertion { | 
| 20 | 4 |  |  | 4 | 1 | 7 | my $self = shift; | 
| 21 | 4 |  |  |  |  | 6 | my $coderef = shift; | 
| 22 | 4 |  |  |  |  | 6 | my $exception_class = $$self; | 
| 23 |  |  |  |  |  |  |  | 
| 24 | 4 |  |  |  |  | 5 | my $exception; | 
| 25 |  |  |  |  |  |  | try { | 
| 26 | 4 |  |  | 4 |  | 93 | &$coderef(); | 
| 27 |  |  |  |  |  |  | } | 
| 28 |  |  |  |  |  |  | catch $exception_class with { | 
| 29 | 2 |  |  | 2 |  | 279 | $exception = shift; | 
| 30 | 4 |  |  |  |  | 24 | }; | 
| 31 |  |  |  |  |  |  |  | 
| 32 | 4 | 100 | 66 |  |  | 73 | if (! $exception || ! $exception->isa($$self)) { | 
| 33 | 2 | 100 |  |  |  | 19 | $self->fail(@_ ? $_[0] : "No $exception_class was raised"); | 
| 34 |  |  |  |  |  |  | } | 
| 35 | 2 |  |  |  |  | 32 | return $exception; # so that it can be stored in the test for the | 
| 36 |  |  |  |  |  |  | # user to get at. | 
| 37 |  |  |  |  |  |  | } | 
| 38 |  |  |  |  |  |  |  | 
| 39 |  |  |  |  |  |  | sub to_string { | 
| 40 | 10 |  |  | 10 | 0 | 14 | my $self = shift; | 
| 41 | 10 |  |  |  |  | 70 | return "$$self exception assertion"; | 
| 42 |  |  |  |  |  |  | } | 
| 43 |  |  |  |  |  |  |  | 
| 44 |  |  |  |  |  |  | 1; | 
| 45 |  |  |  |  |  |  | __END__ |