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;