Commit | Line | Data |
95f1ef68 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use Test::More 'no_plan';; |
7 | |
8 | { |
9 | package Foo; |
10 | use Moose; |
11 | |
12 | has foo => ( is => "ro" ); |
13 | |
14 | package Bar; |
15 | use metaclass ( |
16 | metaclass => "Moose::Meta::Class", |
bf6fa6b3 |
17 | error_class => "Moose::Error::Croak", |
95f1ef68 |
18 | ); |
19 | use Moose; |
20 | |
21 | has foo => ( is => "ro" ); |
22 | |
bf6fa6b3 |
23 | |
95f1ef68 |
24 | package Baz::Error; |
25 | use Moose; |
26 | |
27 | has message => ( isa => "Str", is => "ro" ); |
28 | has attr => ( isa => "Moose::Meta::Attribute", is => "ro" ); |
29 | has method => ( isa => "Moose::Meta::Method", is => "ro" ); |
30 | has metaclass => ( isa => "Moose::Meta::Class", is => "ro" ); |
31 | has data => ( is => "ro" ); |
32 | has line => ( isa => "Int", is => "ro" ); |
33 | has file => ( isa => "Str", is => "ro" ); |
30ef61cd |
34 | has last_error => ( isa => "Any", is => "ro" ); |
bf6fa6b3 |
35 | |
36 | package Baz; |
37 | use metaclass ( |
38 | metaclass => "Moose::Meta::Class", |
39 | error_class => "Baz::Error", |
40 | ); |
41 | use Moose; |
42 | |
43 | has foo => ( is => "ro" ); |
95f1ef68 |
44 | } |
45 | |
46 | my $line; |
47 | sub blah { $line = __LINE__; shift->foo(4) } |
48 | |
49 | sub create_error { |
30ef61cd |
50 | eval { eval { die "Blah" }; blah(shift) }; |
95f1ef68 |
51 | ok( my $e = $@, "got some error" ); |
52 | return { |
53 | file => __FILE__, |
54 | line => $line, |
55 | error => $e, |
56 | } |
57 | } |
58 | |
59 | { |
60 | my $e = create_error(Foo->new); |
61 | ok( !ref($e->{error}), "error is a string" ); |
62 | like( $e->{error}, qr/line $e->{line}\n.*\n/s, "confess" ); |
63 | } |
64 | |
65 | { |
66 | my $e = create_error(Bar->new); |
67 | ok( !ref($e->{error}), "error is a string" ); |
68 | like( $e->{error}, qr/line $e->{line}$/s, "croak" ); |
69 | } |
70 | |
71 | { |
72 | my $e = create_error(my $baz = Baz->new); |
73 | isa_ok( $e->{error}, "Baz::Error" ); |
74 | unlike( $e->{error}->message, qr/line $e->{line}/s, "no line info, just a message" ); |
75 | isa_ok( $e->{error}->metaclass, "Moose::Meta::Class", "metaclass" ); |
76 | is( $e->{error}->metaclass, Baz->meta, "metaclass value" ); |
77 | isa_ok( $e->{error}->attr, "Moose::Meta::Attribute", "attr" ); |
78 | is( $e->{error}->attr, Baz->meta->get_attribute("foo"), "attr value" ); |
79 | isa_ok( $e->{error}->method, "Moose::Meta::Method", "method" ); |
80 | is( $e->{error}->method, Baz->meta->get_method("foo"), "method value" ); |
81 | is( $e->{error}->line, $e->{line}, "line attr" ); |
82 | is( $e->{error}->file, $e->{file}, "file attr" ); |
83 | is_deeply( $e->{error}->data, [ $baz, 4 ], "captured args" ); |
30ef61cd |
84 | like( $e->{error}->last_error, qr/Blah/, "last error preserved" ); |
95f1ef68 |
85 | } |