version bump
[gitmo/Moose.git] / t / metaclasses / throw_error.t
1 #!/usr/bin/perl
2
3 use strict;
4 use warnings;
5
6 use Test::More;
7 use Test::Fatal;
8 use Test::Moose;
9
10 {
11
12     package Foo;
13     use Moose;
14
15     has foo => ( is => "ro" );
16
17     package Bar;
18     use metaclass (
19         metaclass   => "Moose::Meta::Class",
20         error_class => "Moose::Error::Croak",
21     );
22     use Moose;
23
24     has foo => ( is => "ro" );
25
26     BEGIN {
27         package Baz::Error;
28         use Moose;
29         extends 'Moose::Object', 'Moose::Error::Default';
30
31         has message    => ( isa => "Str",                    is => "ro" );
32         has attr       => ( isa => "Moose::Meta::Attribute", is => "ro" );
33         has method     => ( isa => "Moose::Meta::Method",    is => "ro" );
34         has metaclass  => ( isa => "Moose::Meta::Class",     is => "ro" );
35         has data       => ( is  => "ro" );
36         has line       => ( isa => "Int",                    is => "ro" );
37         has file       => ( isa => "Str",                    is => "ro" );
38         has last_error => ( isa => "Any",                    is => "ro" );
39     }
40
41     package Baz;
42     use metaclass (
43         metaclass   => "Moose::Meta::Class",
44         error_class => "Baz::Error",
45     );
46     use Moose;
47
48     has foo => ( is => "ro" );
49 }
50
51 my $line;
52 sub blah { $line = __LINE__; shift->foo(4) }
53
54 sub create_error {
55     eval {
56         eval { die "Blah" };
57         blah(shift);
58     };
59     ok( my $e = $@, "got some error" );
60     return {
61         file  => __FILE__,
62         line  => $line,
63         error => $e,
64     };
65 }
66
67 with_immutable {
68 {
69     my $e = create_error( Foo->new );
70     ok( !ref( $e->{error} ), "error is a string" );
71     like( $e->{error}, qr/line $e->{line}\n.*\n/s, "confess" );
72 }
73
74 {
75     my $e = create_error( Bar->new );
76     ok( !ref( $e->{error} ), "error is a string" );
77     like( $e->{error}, qr/line $e->{line}\.?$/s, "croak" );
78 }
79
80 {
81     my $e = create_error( my $baz = Baz->new );
82     isa_ok( $e->{error}, "Baz::Error" );
83     unlike( $e->{error}->message, qr/line $e->{line}/s,
84         "no line info, just a message" );
85     isa_ok( $e->{error}->metaclass, "Moose::Meta::Class", "metaclass" );
86     is( $e->{error}->metaclass, Baz->meta, "metaclass value" );
87     isa_ok( $e->{error}->attr, "Moose::Meta::Attribute", "attr" );
88     is( $e->{error}->attr, Baz->meta->get_attribute("foo"), "attr value" );
89     isa_ok( $e->{error}->method, "Moose::Meta::Method", "method" );
90     is( $e->{error}->method, Baz->meta->get_method("foo"), "method value" );
91     is( $e->{error}->line,   $e->{line},                   "line attr" );
92     is( $e->{error}->file,   $e->{file},                   "file attr" );
93     is_deeply( $e->{error}->data, [ $baz, 4 ], "captured args" );
94     like( $e->{error}->last_error, qr/Blah/, "last error preserved" );
95 }
96 } 'Foo', 'Bar', 'Baz';
97
98 {
99     package Role::Foo;
100     use Moose::Role;
101
102     sub foo { }
103 }
104
105 {
106     package Baz::Sub;
107
108     use Moose;
109     extends 'Baz';
110
111     Moose::Util::MetaRole::apply_metaroles(
112         for             => __PACKAGE__,
113         class_metaroles => { class => ['Role::Foo'] },
114     );
115 }
116
117 {
118     package Baz::Sub::Sub;
119     use metaclass (
120         metaclass   => 'Moose::Meta::Class',
121         error_class => 'Moose::Error::Croak',
122     );
123     use Moose;
124
125     ::isnt( ::exception { extends 'Baz::Sub' }, undef, 'error_class is included in metaclass compatibility checks' );
126 }
127
128 {
129     package Foo::Sub;
130
131     use metaclass (
132         metaclass   => 'Moose::Meta::Class',
133         error_class => 'Moose::Error::Croak',
134     );
135
136     use Moose;
137
138     Moose::Util::MetaRole::apply_metaroles(
139         for             => __PACKAGE__,
140         class_metaroles => { class => ['Role::Foo'] },
141     );
142 }
143
144 ok( Foo::Sub->meta->error_class->isa('Moose::Error::Croak'),
145     q{Foo::Sub's error_class still isa Moose::Error::Croak} );
146
147 {
148     package Foo::Sub::Sub;
149     use Moose;
150
151     ::is( ::exception { extends 'Foo::Sub' }, undef, 'error_class differs by role so incompat is handled' );
152
153     Moose::Util::MetaRole::apply_metaroles(
154         for             => __PACKAGE__,
155         class_metaroles => { error => ['Role::Foo'] },
156     );
157 }
158
159 ok( Foo::Sub::Sub->meta->error_class->meta->does_role('Role::Foo'),
160     q{Foo::Sub::Sub's error_class does Role::Foo} );
161 ok( Foo::Sub::Sub->meta->error_class->isa('Moose::Error::Croak'),
162     q{Foo::Sub::Sub's error_class now subclasses Moose::Error::Croak} );
163
164 {
165     package Quux::Default;
166     use Moose;
167
168     has foo => (is => 'ro');
169     sub bar { shift->foo(1) }
170 }
171
172 {
173     package Quux::Croak;
174     use metaclass 'Moose::Meta::Class', error_class => 'Moose::Error::Croak';
175     use Moose;
176
177     has foo => (is => 'ro');
178     sub bar { shift->foo(1) }
179 }
180
181 {
182     package Quux::Confess;
183     use metaclass 'Moose::Meta::Class', error_class => 'Moose::Error::Confess';
184     use Moose;
185
186     has foo => (is => 'ro');
187     sub bar { shift->foo(1) }
188 }
189
190 sub stacktrace_ok (&) {
191     local $Test::Builder::Level = $Test::Builder::Level + 1;
192     my $code = shift;
193     eval { $code->() };
194     my @lines = split /\n/, $@;
195     cmp_ok(scalar(@lines), '>', 1, "got a stacktrace");
196 }
197
198 sub stacktrace_not_ok (&) {
199     local $Test::Builder::Level = $Test::Builder::Level + 1;
200     my $code = shift;
201     eval { $code->() };
202     my @lines = split /\n/, $@;
203     cmp_ok(scalar(@lines), '==', 1, "didn't get a stacktrace");
204 }
205
206 with_immutable {
207 my $default = Quux::Default->new;
208 my $croak = Quux::Croak->new;
209 my $confess = Quux::Confess->new;
210
211 is($default->meta->error_class, 'Moose::Error::Default');
212 is($croak->meta->error_class, 'Moose::Error::Croak');
213 is($confess->meta->error_class, 'Moose::Error::Confess');
214
215 {
216     local $ENV{MOOSE_ERROR_STYLE};
217     stacktrace_ok { $default->bar };
218     stacktrace_not_ok { $croak->bar };
219     stacktrace_ok { $confess->bar };
220 }
221
222 {
223     local $ENV{MOOSE_ERROR_STYLE} = 'croak';
224     stacktrace_not_ok { $default->bar };
225     stacktrace_not_ok { $croak->bar };
226     stacktrace_ok { $confess->bar };
227 }
228
229 {
230     local $ENV{MOOSE_ERROR_STYLE} = 'confess';
231     stacktrace_ok { $default->bar };
232     stacktrace_not_ok { $croak->bar };
233     stacktrace_ok { $confess->bar };
234 }
235 } 'Quux::Default', 'Quux::Croak', 'Quux::Confess';
236
237 done_testing;