t/050_metaclasses/failing/018_throw_error.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 24;
   7 use Test::Exception;
   8
   9 {
  10
  11     package Foo;
  12     use Mouse;
  13
  14     has foo => ( is => "ro" );
  15
  16     package Bar;
  17     use metaclass (
  18         metaclass   => "Mouse::Meta::Class",
  19         error_class => "Mouse::Error::Croak",
  20     );
  21     use Mouse;
  22
  23     has foo => ( is => "ro" );
  24
  25     package Baz::Error;
  26     use Mouse;
  27
  28     has message    => ( isa => "Str",                    is => "ro" );
  29     has attr       => ( isa => "Mouse::Meta::Attribute", is => "ro" );
  30     has method     => ( isa => "Mouse::Meta::Method",    is => "ro" );
  31     has metaclass  => ( isa => "Mouse::Meta::Class",     is => "ro" );
  32     has data       => ( is  => "ro" );
  33     has line       => ( isa => "Int",                    is => "ro" );
  34     has file       => ( isa => "Str",                    is => "ro" );
  35     has last_error => ( isa => "Any",                    is => "ro" );
  36
  37     package Baz;
  38     use metaclass (
  39         metaclass   => "Mouse::Meta::Class",
  40         error_class => "Baz::Error",
  41     );
  42     use Mouse;
  43
  44     has foo => ( is => "ro" );
  45 }
  46
  47 my $line;
  48 sub blah { $line = __LINE__; shift->foo(4) }
  49
  50 sub create_error {
  51     eval {
  52         eval { die "Blah" };
  53         blah(shift);
  54     };
  55     ok( my $e = $@, "got some error" );
  56     return {
  57         file  => __FILE__,
  58         line  => $line,
  59         error => $e,
  60     };
  61 }
  62
  63 {
  64     my $e = create_error( Foo->new );
  65     ok( !ref( $e->{error} ), "error is a string" );
  66     like( $e->{error}, qr/line $e->{line}\n.*\n/s, "confess" );
  67 }
  68
  69 {
  70     my $e = create_error( Bar->new );
  71     ok( !ref( $e->{error} ), "error is a string" );
  72     like( $e->{error}, qr/line $e->{line}$/s, "croak" );
  73 }
  74
  75 {
  76     my $e = create_error( my $baz = Baz->new );
  77     isa_ok( $e->{error}, "Baz::Error" );
  78     unlike( $e->{error}->message, qr/line $e->{line}/s,
  79         "no line info, just a message" );
  80     isa_ok( $e->{error}->metaclass, "Mouse::Meta::Class", "metaclass" );
  81     is( $e->{error}->metaclass, Baz->meta, "metaclass value" );
  82     isa_ok( $e->{error}->attr, "Mouse::Meta::Attribute", "attr" );
  83     is( $e->{error}->attr, Baz->meta->get_attribute("foo"), "attr value" );
  84     isa_ok( $e->{error}->method, "Mouse::Meta::Method", "method" );
  85     is( $e->{error}->method, Baz->meta->get_method("foo"), "method value" );
  86     is( $e->{error}->line,   $e->{line},                   "line attr" );
  87     is( $e->{error}->file,   $e->{file},                   "file attr" );
  88     is_deeply( $e->{error}->data, [ $baz, 4 ], "captured args" );
  89     like( $e->{error}->last_error, qr/Blah/, "last error preserved" );
  90 }
  91
  92 {
  93     package Role::Foo;
  94     use Mouse::Role;
  95
  96     sub foo { }
  97 }
  98
  99 {
 100     package Baz::Sub;
 101
 102     use Mouse;
 103     extends 'Baz';
 104
 105     Mouse::Util::MetaRole::apply_metaclass_roles(
 106         for_class       => __PACKAGE__,
 107         metaclass_roles => ['Role::Foo'],
 108     );
 109 }
 110
 111 {
 112     package Baz::Sub::Sub;
 113     use metaclass (
 114         metaclass   => 'Mouse::Meta::Class',
 115         error_class => 'Mouse::Error::Croak',
 116     );
 117     use Mouse;
 118
 119     ::dies_ok { extends 'Baz::Sub' } 'error_class is included in metaclass compatibility checks';
 120 }
 121
 122 {
 123     package Foo::Sub;
 124
 125     use metaclass (
 126         metaclass   => 'Mouse::Meta::Class',
 127         error_class => 'Mouse::Error::Croak',
 128     );
 129
 130     use Mouse;
 131
 132     Mouse::Util::MetaRole::apply_metaclass_roles(
 133         for_class         => __PACKAGE__,
 134         metaclass_roles => ['Role::Foo'],
 135     );
 136 }
 137
 138 ok( Foo::Sub->meta->error_class->isa('Mouse::Error::Croak'),
 139     q{Foo::Sub's error_class still isa Mouse::Error::Croak} );
 140
 141 {
 142     package Foo::Sub::Sub;
 143     use Mouse;
 144
 145     ::lives_ok { extends 'Foo::Sub' } 'error_class differs by role so incompat is handled';
 146
 147     Mouse::Util::MetaRole::apply_metaclass_roles(
 148         for_class         => __PACKAGE__,
 149         error_class_roles => ['Role::Foo'],
 150     );
 151 }
 152
 153 ok( Foo::Sub::Sub->meta->error_class->meta->does_role('Role::Foo'),
 154     q{Foo::Sub::Sub's error_class does Role::Foo} );
 155 ok( Foo::Sub::Sub->meta->error_class->isa('Mouse::Error::Croak'),
 156     q{Foo::Sub::Sub's error_class now subclasses Mouse::Error::Croak} );