Commit | Line | Data |
95f1ef68 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
a28e50e4 |
6 | use Test::More; |
b10dde3a |
7 | use Test::Fatal; |
bcc04ae1 |
8 | use Test::Moose; |
95f1ef68 |
9 | |
10 | { |
ab25e388 |
11 | |
95f1ef68 |
12 | package Foo; |
13 | use Moose; |
14 | |
ab25e388 |
15 | has foo => ( is => "ro" ); |
95f1ef68 |
16 | |
17 | package Bar; |
18 | use metaclass ( |
ab25e388 |
19 | metaclass => "Moose::Meta::Class", |
bf6fa6b3 |
20 | error_class => "Moose::Error::Croak", |
95f1ef68 |
21 | ); |
22 | use Moose; |
23 | |
ab25e388 |
24 | has foo => ( is => "ro" ); |
95f1ef68 |
25 | |
117154c4 |
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 | } |
bf6fa6b3 |
40 | |
41 | package Baz; |
42 | use metaclass ( |
ab25e388 |
43 | metaclass => "Moose::Meta::Class", |
bf6fa6b3 |
44 | error_class => "Baz::Error", |
45 | ); |
46 | use Moose; |
47 | |
ab25e388 |
48 | has foo => ( is => "ro" ); |
95f1ef68 |
49 | } |
50 | |
51 | my $line; |
52 | sub blah { $line = __LINE__; shift->foo(4) } |
53 | |
54 | sub create_error { |
ab25e388 |
55 | eval { |
56 | eval { die "Blah" }; |
57 | blah(shift); |
58 | }; |
95f1ef68 |
59 | ok( my $e = $@, "got some error" ); |
60 | return { |
ab25e388 |
61 | file => __FILE__, |
62 | line => $line, |
95f1ef68 |
63 | error => $e, |
ab25e388 |
64 | }; |
95f1ef68 |
65 | } |
66 | |
bcc04ae1 |
67 | with_immutable { |
95f1ef68 |
68 | { |
ab25e388 |
69 | my $e = create_error( Foo->new ); |
70 | ok( !ref( $e->{error} ), "error is a string" ); |
95f1ef68 |
71 | like( $e->{error}, qr/line $e->{line}\n.*\n/s, "confess" ); |
72 | } |
73 | |
74 | { |
ab25e388 |
75 | my $e = create_error( Bar->new ); |
76 | ok( !ref( $e->{error} ), "error is a string" ); |
95f1ef68 |
77 | like( $e->{error}, qr/line $e->{line}$/s, "croak" ); |
78 | } |
79 | |
80 | { |
ab25e388 |
81 | my $e = create_error( my $baz = Baz->new ); |
95f1ef68 |
82 | isa_ok( $e->{error}, "Baz::Error" ); |
ab25e388 |
83 | unlike( $e->{error}->message, qr/line $e->{line}/s, |
84 | "no line info, just a message" ); |
95f1ef68 |
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" ); |
ab25e388 |
91 | is( $e->{error}->line, $e->{line}, "line attr" ); |
92 | is( $e->{error}->file, $e->{file}, "file attr" ); |
95f1ef68 |
93 | is_deeply( $e->{error}->data, [ $baz, 4 ], "captured args" ); |
30ef61cd |
94 | like( $e->{error}->last_error, qr/Blah/, "last error preserved" ); |
95f1ef68 |
95 | } |
bcc04ae1 |
96 | } 'Foo', 'Bar', 'Baz'; |
1aa93ae8 |
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 | |
f785aad8 |
111 | Moose::Util::MetaRole::apply_metaroles( |
112 | for => __PACKAGE__, |
113 | class_metaroles => { class => ['Role::Foo'] }, |
1aa93ae8 |
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 | |
b10dde3a |
125 | ::isnt( ::exception { extends 'Baz::Sub' }, undef, 'error_class is included in metaclass compatibility checks' ); |
1aa93ae8 |
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 | |
f785aad8 |
138 | Moose::Util::MetaRole::apply_metaroles( |
139 | for => __PACKAGE__, |
140 | class_metaroles => { class => ['Role::Foo'] }, |
1aa93ae8 |
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 | |
b10dde3a |
151 | ::is( ::exception { extends 'Foo::Sub' }, undef, 'error_class differs by role so incompat is handled' ); |
1aa93ae8 |
152 | |
f785aad8 |
153 | Moose::Util::MetaRole::apply_metaroles( |
154 | for => __PACKAGE__, |
155 | class_metaroles => { error => ['Role::Foo'] }, |
1aa93ae8 |
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} ); |
a28e50e4 |
163 | |
6d753f0e |
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 | |
bcc04ae1 |
206 | with_immutable { |
6d753f0e |
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 | } |
bcc04ae1 |
235 | } 'Quux::Default', 'Quux::Croak', 'Quux::Confess'; |
6d753f0e |
236 | |
a28e50e4 |
237 | done_testing; |