t/050_metaclasses/018_throw_error.t

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