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     package Foo;
  10     use Moose;
  11
  12     has foo => ( is  => "ro" );
  13
  14     package Bar;
  15     use metaclass (
  16         metaclass => "Moose::Meta::Class",
  17         error_class => "Moose::Error::Croak",
  18     );
  19     use Moose;
  20
  21     has foo => ( is  => "ro" );
  22
  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 { eval { die "Blah" }; blah(shift) };
  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" );
  84     like( $e->{error}->last_error, qr/Blah/, "last error preserved" );
  85 }