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::Fatal;
   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     ::isnt( ::exception { extends 'Baz::Sub' }, undef, '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     ::is( ::exception { extends 'Foo::Sub' }, undef, '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 {
 162     package Quux::Default;
 163     use Moose;
 164
 165     has foo => (is => 'ro');
 166     sub bar { shift->foo(1) }
 167 }
 168
 169 {
 170     package Quux::Croak;
 171     use metaclass 'Moose::Meta::Class', error_class => 'Moose::Error::Croak';
 172     use Moose;
 173
 174     has foo => (is => 'ro');
 175     sub bar { shift->foo(1) }
 176 }
 177
 178 {
 179     package Quux::Confess;
 180     use metaclass 'Moose::Meta::Class', error_class => 'Moose::Error::Confess';
 181     use Moose;
 182
 183     has foo => (is => 'ro');
 184     sub bar { shift->foo(1) }
 185 }
 186
 187 sub stacktrace_ok (&) {
 188     local $Test::Builder::Level = $Test::Builder::Level + 1;
 189     my $code = shift;
 190     eval { $code->() };
 191     my @lines = split /\n/, $@;
 192     cmp_ok(scalar(@lines), '>', 1, "got a stacktrace");
 193 }
 194
 195 sub stacktrace_not_ok (&) {
 196     local $Test::Builder::Level = $Test::Builder::Level + 1;
 197     my $code = shift;
 198     eval { $code->() };
 199     my @lines = split /\n/, $@;
 200     cmp_ok(scalar(@lines), '==', 1, "didn't get a stacktrace");
 201 }
 202
 203 my $default = Quux::Default->new;
 204 my $croak = Quux::Croak->new;
 205 my $confess = Quux::Confess->new;
 206
 207 is($default->meta->error_class, 'Moose::Error::Default');
 208 is($croak->meta->error_class, 'Moose::Error::Croak');
 209 is($confess->meta->error_class, 'Moose::Error::Confess');
 210
 211 {
 212     local $ENV{MOOSE_ERROR_STYLE};
 213     stacktrace_ok { $default->bar };
 214     stacktrace_not_ok { $croak->bar };
 215     stacktrace_ok { $confess->bar };
 216 }
 217
 218 {
 219     local $ENV{MOOSE_ERROR_STYLE} = 'croak';
 220     stacktrace_not_ok { $default->bar };
 221     stacktrace_not_ok { $croak->bar };
 222     stacktrace_ok { $confess->bar };
 223 }
 224
 225 {
 226     local $ENV{MOOSE_ERROR_STYLE} = 'confess';
 227     stacktrace_ok { $default->bar };
 228     stacktrace_not_ok { $croak->bar };
 229     stacktrace_ok { $confess->bar };
 230 }
 231
 232 done_testing;