t/050_metaclasses/018_throw_error.t

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