X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FUtil.pm;h=476075d04556f53f88468ea379456867ac7e674e;hp=d30abf3b6ad77a7dfcb6a96ec89def6818a97014;hb=11ac534bdfe4aab1f8bfb575769dee68f456c1d9;hpb=42d7df00cd4c4b4cd1fe20ffb1a74c7161ba3862 diff --git a/lib/Mouse/Util.pm b/lib/Mouse/Util.pm index d30abf3..476075d 100644 --- a/lib/Mouse/Util.pm +++ b/lib/Mouse/Util.pm @@ -3,6 +3,7 @@ package Mouse::Util; use strict; use warnings; use base 'Exporter'; +use Carp; BEGIN { our %dependencies = ( @@ -120,64 +121,6 @@ BEGIN { }, # ^^^^^ CODE TAKEN FROM MRO::COMPAT ^^^^^ }, -# VVVVV CODE TAKEN FROM TEST::EXCEPTION VVVVV - 'Test::Exception' => do { - - my $Tester = Test::Builder->new; - - 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); - - 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 ); - my $ok = $Tester->ok( ! $is_exception->( $exception ), $description ); - $Tester->diag( $exception_as_string->( "died:", $exception ) ) unless $ok; - $@ = $exception; - return $ok; - }, - }, - }, ); our %loaded; @@ -185,7 +128,6 @@ BEGIN { our @EXPORT_OK = map { keys %$_ } values %dependencies; our %EXPORT_TAGS = ( all => \@EXPORT_OK, - test => [qw/throws_ok lives_ok/], ); for my $module_name (keys %dependencies) { @@ -217,6 +159,15 @@ BEGIN { } } +sub apply_all_roles { + my $meta = Mouse::Meta::Class->initialize(shift); + my $role = shift; + confess "Mouse::Util only supports 'apply_all_roles' on individual roles at a time" if @_; + + Mouse::load_class($role); + $role->meta->apply($meta); +} + 1; __END__