From: Tokuhiro Matsuno Date: Tue, 2 Dec 2008 07:17:38 +0000 (+0000) Subject: don't require Test::Exception on production environment =) X-Git-Tag: 0.19~136^2~87 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=commitdiff_plain;h=3118622d182add6c88792d5de3b4af047e8a7c8c don't require Test::Exception on production environment =) --- diff --git a/lib/Mouse/Util.pm b/lib/Mouse/Util.pm index 0c95684..c244e50 100644 --- a/lib/Mouse/Util.pm +++ b/lib/Mouse/Util.pm @@ -121,69 +121,6 @@ BEGIN { }, # ^^^^^ CODE TAKEN FROM MRO::COMPAT ^^^^^ }, -# VVVVV CODE TAKEN FROM TEST::EXCEPTION VVVVV - 'Test::Exception' => do { - - my $Tester; - - my $is_exception = sub { - my $exception = shift; - return ref $exception || $exception ne ''; - }; - - my $exception_as_string = sub { - my ( $prefix, $exception ) = @_; - return "$prefix normal exit" unless $is_exception->( $exception ); - my $class = ref $exception; - $exception = "$class ($exception)" - if $class && "$exception" !~ m/^\Q$class/; - chomp $exception; - return "$prefix $exception"; - }; - my $try_as_caller = sub { - my $coderef = shift; - eval { $coderef->() }; - $@; - }; - - { - 'throws_ok' => sub (&$;$) { - my ( $coderef, $expecting, $description ) = @_; - Carp::croak "throws_ok: must pass exception class/object or regex" - unless defined $expecting; - $description = $exception_as_string->( "threw", $expecting ) - unless defined $description; - my $exception = $try_as_caller->($coderef); - - $Tester ||= Test::Builder->new; - - my $regex = $Tester->maybe_regex( $expecting ); - my $ok = $regex - ? ( $exception =~ m/$regex/ ) - : eval { - $exception->isa( ref $expecting ? ref $expecting : $expecting ) - }; - $Tester->ok( $ok, $description ); - unless ( $ok ) { - $Tester->diag( $exception_as_string->( "expecting:", $expecting ) ); - $Tester->diag( $exception_as_string->( "found:", $exception ) ); - }; - $@ = $exception; - return $ok; - }, - 'lives_ok' => sub (&;$) { - my ( $coderef, $description ) = @_; - my $exception = $try_as_caller->( $coderef ); - - $Tester ||= Test::Builder->new; - - my $ok = $Tester->ok( ! $is_exception->( $exception ), $description ); - $Tester->diag( $exception_as_string->( "died:", $exception ) ) unless $ok; - $@ = $exception; - return $ok; - }, - }, - }, ); our %loaded; diff --git a/t/001-strict.t b/t/001-strict.t index 15b9784..50f4b41 100644 --- a/t/001-strict.t +++ b/t/001-strict.t @@ -1,6 +1,6 @@ #!/usr/bin/env perl use Test::More tests => 1; -use Mouse::Util ':test'; +use t::Exception; throws_ok { package Class; diff --git a/t/007-attributes.t b/t/007-attributes.t index 869ed33..140d0db 100644 --- a/t/007-attributes.t +++ b/t/007-attributes.t @@ -2,7 +2,7 @@ use strict; use warnings; use Test::More tests => 10; -use Mouse::Util ':test'; +use t::Exception; do { package Class; diff --git a/t/010-required.t b/t/010-required.t index 0bf5f83..6962a29 100644 --- a/t/010-required.t +++ b/t/010-required.t @@ -2,7 +2,7 @@ use strict; use warnings; use Test::More tests => 3; -use Mouse::Util ':test'; +use t::Exception; do { package Class; diff --git a/t/011-lazy.t b/t/011-lazy.t index 656163f..e23e674 100644 --- a/t/011-lazy.t +++ b/t/011-lazy.t @@ -2,7 +2,7 @@ use strict; use warnings; use Test::More tests => 16; -use Mouse::Util ':test'; +use t::Exception; my $lazy_run = 0; diff --git a/t/016-trigger.t b/t/016-trigger.t index 29406c4..06f0aff 100644 --- a/t/016-trigger.t +++ b/t/016-trigger.t @@ -2,7 +2,7 @@ use strict; use warnings; use Test::More tests => 11; -use Mouse::Util ':test'; +use t::Exception; my @trigger; diff --git a/t/017-default-reference.t b/t/017-default-reference.t index 18dc7b2..b169ddd 100644 --- a/t/017-default-reference.t +++ b/t/017-default-reference.t @@ -2,7 +2,7 @@ use strict; use warnings; use Test::More tests => 8; -use Mouse::Util ':test'; +use t::Exception; do { package Class; diff --git a/t/019-handles.t b/t/019-handles.t index 5dbef10..7911f3c 100644 --- a/t/019-handles.t +++ b/t/019-handles.t @@ -2,7 +2,7 @@ use strict; use warnings; use Test::More tests => 24; -use Mouse::Util ':test'; +use t::Exception; do { package Person; diff --git a/t/020-load-class.t b/t/020-load-class.t index 8e8dc45..b95d180 100644 --- a/t/020-load-class.t +++ b/t/020-load-class.t @@ -2,7 +2,7 @@ use strict; use warnings; use Test::More tests => 11; -use Mouse::Util ':test'; +use t::Exception; require Mouse; use lib 't/lib'; diff --git a/t/021-weak-ref.t b/t/021-weak-ref.t index aa1a009..e626f35 100644 --- a/t/021-weak-ref.t +++ b/t/021-weak-ref.t @@ -12,7 +12,7 @@ BEGIN { } } -use Mouse::Util ':test'; +use t::Exception; my %destroyed; diff --git a/t/023-builder.t b/t/023-builder.t index 24187ba..b3cf1c7 100644 --- a/t/023-builder.t +++ b/t/023-builder.t @@ -2,7 +2,7 @@ use strict; use warnings; use Test::More tests => 47; -use Mouse::Util ':test'; +use t::Exception; my $builder_called = 0; my $lazy_builder_called = 0; diff --git a/t/024-isa.t b/t/024-isa.t index d3869f0..bae920e 100644 --- a/t/024-isa.t +++ b/t/024-isa.t @@ -3,7 +3,7 @@ use strict; use warnings; use Test::More; use IO::Handle; -use Mouse::Util ':test'; +use t::Exception; my @types = qw/Any Item Bool Undef Defined Value Num Int Str ClassName Ref ScalarRef ArrayRef HashRef CodeRef RegexpRef GlobRef diff --git a/t/025-more-isa.t b/t/025-more-isa.t index f092bed..9db3441 100644 --- a/t/025-more-isa.t +++ b/t/025-more-isa.t @@ -2,7 +2,7 @@ use strict; use warnings; use Test::More tests => 29; -use Mouse::Util ':test'; +use t::Exception; do { package Class; diff --git a/t/026-auto-deref.t b/t/026-auto-deref.t index 577a7eb..efc3987 100644 --- a/t/026-auto-deref.t +++ b/t/026-auto-deref.t @@ -2,7 +2,7 @@ use strict; use warnings; use Test::More tests => 15; -use Mouse::Util ':test'; +use t::Exception; do { package Class; diff --git a/t/029-new.t b/t/029-new.t index a14b570..c35ce6c 100644 --- a/t/029-new.t +++ b/t/029-new.t @@ -2,7 +2,7 @@ use strict; use warnings; use Test::More tests => 5; -use Mouse::Util ':test'; +use t::Exception; do { package Class; diff --git a/t/030-has-plus.t b/t/030-has-plus.t index bf62859..0c83dcf 100644 --- a/t/030-has-plus.t +++ b/t/030-has-plus.t @@ -2,7 +2,7 @@ use strict; use warnings; use Test::More tests => 3; -use Mouse::Util ':test'; +use t::Exception; do { package Class; diff --git a/t/031-clone.t b/t/031-clone.t index fd2a3bf..711aaf5 100644 --- a/t/031-clone.t +++ b/t/031-clone.t @@ -2,7 +2,7 @@ use strict; use warnings; use Test::More tests => 10; -use Mouse::Util ':test'; +use t::Exception; do { package Foo; diff --git a/t/033-requires.t b/t/033-requires.t index da4f10f..dd02d86 100644 --- a/t/033-requires.t +++ b/t/033-requires.t @@ -2,7 +2,7 @@ use strict; use warnings; use Test::More tests => 1; -use Mouse::Util ':test'; +use t::Exception; { package Foo; diff --git a/t/034-apply_all_roles.t b/t/034-apply_all_roles.t index 557cd5d..4b0dd5c 100644 --- a/t/034-apply_all_roles.t +++ b/t/034-apply_all_roles.t @@ -2,7 +2,7 @@ use strict; use warnings; use Test::More tests => 4; -use Mouse::Util ':test'; +use t::Exception; { package FooRole; diff --git a/t/037-dont-load-test-exception.t b/t/037-dont-load-test-exception.t new file mode 100644 index 0000000..e1b4bea --- /dev/null +++ b/t/037-dont-load-test-exception.t @@ -0,0 +1,6 @@ +use strict; +use warnings; +use Test::More tests => 1; +use Mouse; + +is $INC{'Test/Exception.pm'}, undef, "don't load Test::Exception on production environment"; diff --git a/t/301-bugs-non-mouse.t b/t/301-bugs-non-mouse.t index 0f30b3a..413b208 100644 --- a/t/301-bugs-non-mouse.t +++ b/t/301-bugs-non-mouse.t @@ -4,7 +4,7 @@ use strict; use warnings; use Test::More 'no_plan'; -use Mouse::Util ':test'; +use t::Exception; { package Foo; diff --git a/t/400-define-role.t b/t/400-define-role.t index 5f130cc..5e1e2d1 100644 --- a/t/400-define-role.t +++ b/t/400-define-role.t @@ -2,7 +2,7 @@ use strict; use warnings; use Test::More tests => 11; -use Mouse::Util ':test'; +use t::Exception; lives_ok { package Role; diff --git a/t/402-attribute-application.t b/t/402-attribute-application.t index 23ff3a2..136ffdc 100644 --- a/t/402-attribute-application.t +++ b/t/402-attribute-application.t @@ -2,7 +2,7 @@ use strict; use warnings; use Test::More tests => 11; -use Mouse::Util ':test'; +use t::Exception; do { package Role; diff --git a/t/403-method-modifiers.t b/t/403-method-modifiers.t index 141534b..8daf21f 100644 --- a/t/403-method-modifiers.t +++ b/t/403-method-modifiers.t @@ -10,7 +10,7 @@ BEGIN { plan skip_all => "Class::Method::Modifiers required for this test"; } } -use Mouse::Util ':test'; +use t::Exception; my @calls; my ($before, $after, $around); diff --git a/t/500_moose_extends_mouse.t b/t/500_moose_extends_mouse.t index 31e7afe..526d4a9 100644 --- a/t/500_moose_extends_mouse.t +++ b/t/500_moose_extends_mouse.t @@ -4,12 +4,13 @@ use strict; use warnings; use Test::More; +use t::Exception; BEGIN { plan skip_all => "Moose required for this test" unless eval { require Moose && Moose->VERSION('0.59') }; plan tests => 27; } -use Mouse::Util ':test'; +use t::Exception; { package Foo; diff --git a/t/Exception.pm b/t/Exception.pm new file mode 100644 index 0000000..d984d29 --- /dev/null +++ b/t/Exception.pm @@ -0,0 +1,67 @@ +package t::Exception; +use strict; +use warnings; +use base qw/Exporter/; + +our @EXPORT = qw/throws_ok lives_ok/; + +my $Tester; + +my $is_exception = sub { + my $exception = shift; + return ref $exception || $exception ne ''; +}; + +my $exception_as_string = sub { + my ( $prefix, $exception ) = @_; + return "$prefix normal exit" unless $is_exception->( $exception ); + my $class = ref $exception; + $exception = "$class ($exception)" + if $class && "$exception" !~ m/^\Q$class/; + chomp $exception; + return "$prefix $exception"; +}; +my $try_as_caller = sub { + my $coderef = shift; + eval { $coderef->() }; + $@; +}; + +sub throws_ok (&$;$) { + my ( $coderef, $expecting, $description ) = @_; + Carp::croak "throws_ok: must pass exception class/object or regex" + unless defined $expecting; + $description = $exception_as_string->( "threw", $expecting ) + unless defined $description; + my $exception = $try_as_caller->($coderef); + + $Tester ||= Test::Builder->new; + + my $regex = $Tester->maybe_regex( $expecting ); + my $ok = $regex + ? ( $exception =~ m/$regex/ ) + : eval { + $exception->isa( ref $expecting ? ref $expecting : $expecting ) + }; + $Tester->ok( $ok, $description ); + unless ( $ok ) { + $Tester->diag( $exception_as_string->( "expecting:", $expecting ) ); + $Tester->diag( $exception_as_string->( "found:", $exception ) ); + }; + $@ = $exception; + return $ok; +} + +sub lives_ok (&;$) { + my ( $coderef, $description ) = @_; + my $exception = $try_as_caller->( $coderef ); + + $Tester ||= Test::Builder->new; + + my $ok = $Tester->ok( ! $is_exception->( $exception ), $description ); + $Tester->diag( $exception_as_string->( "died:", $exception ) ) unless $ok; + $@ = $exception; + return $ok; +} + +1;