t/300_immutable/004_inlined_constructors_n_types.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Exception;
   8
   9 =pod
  10
  11 This tests to make sure that the inlined constructor
  12 has all the type constraints in order, even in the
  13 cases when there is no type constraint available, such
  14 as with a Class::MOP::Attribute object.
  15
  16 =cut
  17
  18 {
  19     package Foo;
  20     use Moose;
  21     use Moose::Util::TypeConstraints;
  22
  23     coerce 'Int' => from 'Str' => via { length $_ ? $_ : 69 };
  24
  25     has 'foo' => (is => 'rw', isa => 'Int');
  26     has 'baz' => (is => 'rw', isa => 'Int');
  27     has 'zot' => (is => 'rw', isa => 'Int', init_arg => undef);
  28     has 'moo' => (is => 'rw', isa => 'Int', coerce => 1, default => '', required => 1);
  29     has 'boo' => (is => 'rw', isa => 'Int', coerce => 1, builder => '_build_boo', required => 1);
  30
  31     sub _build_boo { '' }
  32
  33     Foo->meta->add_attribute(
  34         Class::MOP::Attribute->new(
  35             'bar' => (
  36                 accessor => 'bar',
  37             )
  38         )
  39     );
  40 }
  41
  42 for (1..2) {
  43     my $is_immutable   = Foo->meta->is_immutable;
  44     my $mutable_string = $is_immutable ? 'immutable' : 'mutable';
  45     lives_ok {
  46         my $f = Foo->new(foo => 10, bar => "Hello World", baz => 10, zot => 4);
  47         is($f->moo, 69, "Type coercion works as expected on default ($mutable_string)");
  48         is($f->boo, 69, "Type coercion works as expected on builder ($mutable_string)");
  49     } "... this passes the constuctor correctly ($mutable_string)";
  50
  51     lives_ok {
  52         Foo->new(foo => 10, bar => "Hello World", baz => 10, zot => "not an int");
  53     } "... the constructor doesn't care about 'zot' ($mutable_string)";
  54
  55     dies_ok {
  56         Foo->new(foo => "Hello World", bar => 100, baz => "Hello World");
  57     } "... this fails the constuctor correctly ($mutable_string)";
  58
  59     Foo->meta->make_immutable(debug => 0) unless $is_immutable;
  60 }
  61
  62 done_testing;