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         undef,
  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     is(
 126         $error->package, 'My::TestMutable',
 127         'got the right package (mutable class)'
 128     );
 129     is( $error->line, 42, 'got the right line (mutable class)' );
 130 }
 131
 132 done_testing;