fix a test (do we want to do this?)
[gitmo/Moose.git] / 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;