t/metaclasses/custom_attr_meta_with_roles.t uses parent
[gitmo/Moose.git] / t / metaclasses / custom_error_class.t
1 use strict;
2 use warnings;
3
4 use Test::More;
5
6 use Test::Requires {
7     'Test::Output' => '0.01',
8 };
9
10 {
11     package My::Exception;
12
13     use Moose;
14
15     has error => (
16         is       => 'ro',
17         isa      => 'Str',
18         required => 1,
19     );
20
21     has [qw( line file package )] => (
22         is       => 'ro',
23         required => 1,
24     );
25
26     sub throw {
27         my ($self) = @_;
28         die $self;
29     }
30 }
31
32 {
33     package My::Error;
34
35     use parent qw( Moose::Error::Default );
36
37     sub new {
38         my ( $self, @args ) = @_;
39
40         $self->create_error_exception(@args)->throw;
41     }
42
43     sub create_error_exception {
44         my ( $self, %params ) = @_;
45
46         my $exception = My::Exception->new(
47             error   => $params{message},
48             line    => $params{line},
49             file    => $params{file},
50             package => $params{pack},
51         );
52
53         return $exception;
54     }
55 }
56
57 {
58     package My::Class;
59
60     use Moose;
61
62     __PACKAGE__->meta->error_class("My::Error");
63
64     has 'test1' => (
65         is       => 'rw',
66         required => 1,
67     );
68
69     ::stderr_is(
70         sub { __PACKAGE__->meta->make_immutable },
71         q{},
72         'no warnings when calling make_immutable with a custom error class'
73     );
74 }
75
76 {
77     package My::ClassMutable;
78
79     use Moose;
80
81     __PACKAGE__->meta->error_class("My::Error");
82
83     has 'test1' => (
84         is       => 'rw',
85         required => 1,
86     );
87 }
88
89 {
90     eval {
91         package My::Test;
92 # line 42
93         My::Class->new;
94     };
95     my $error = $@;
96
97     isa_ok(
98         $error, 'My::Exception',
99         'got exception object (immutable class)'
100     );
101     is(
102         $error->error, 'Attribute (test1) is required',
103         'got the right message (immutable class)'
104     );
105     is(
106         $error->package, 'My::Test',
107         'got the right package (immutable class)'
108     );
109     is( $error->line, 42, 'got the right line (immutable class)' );
110 }
111
112 {
113     eval {
114         package My::TestMutable;
115 # line 42
116         My::ClassMutable->new;
117     };
118     my $error = $@;
119
120     isa_ok( $error, 'My::Exception', 'got exception object (mutable class)' );
121     is(
122         $error->error, 'Attribute (test1) is required',
123         'got the right message (mutable class)'
124     );
125 }
126
127 done_testing;