t/900_bug/001_immutable_types.t

   1 use strict;
   2 use warnings;
   3 use Test::More tests => 4;
   4 use Mouse::Util::TypeConstraints;
   5
   6 subtype 'Foo', as 'Object', where { $_->isa('A') };
   7
   8 {
   9     package A;
  10     use Mouse;
  11     has data => ( is => 'rw', isa => 'Str' );
  12 }
  13
  14 {
  15     package C;
  16     use Mouse;
  17     has a => ( is => 'rw', isa => 'Foo', coerce => 1 );
  18 }
  19
  20 isa_ok(C->new(a => A->new()), 'C');
  21 C->meta->make_immutable;
  22 isa_ok(C->new(a => A->new()), 'C');
  23
  24
  25
  26 # The BUILD invocation order used to get reversed after
  27 # making a class immutable.  This checks it is correct.
  28 {
  29     package D;
  30     use Mouse;
  31
  32     # we'll keep
  33     has order =>
  34         (is => 'ro',
  35          default => sub {[]});
  36
  37     sub BUILD { push @{shift->order}, 'D' }
  38
  39     package E;
  40     use Mouse;
  41     extends 'D';
  42
  43     sub BUILD { push @{shift->order}, 'E' }
  44
  45     package F;
  46     use Mouse;
  47     extends 'E';
  48
  49     sub BUILD { push @{shift->order}, 'F' }
  50
  51
  52 }
  53
  54 my $obj = F->new;
  55
  56 print join(", ", @{$obj->order}),"\n";
  57 is_deeply $obj->order, [qw(D E F)], "mutable BUILD invocation order correct";
  58
  59 # now make the classes immutable
  60 $_->meta->make_immutable for qw(D E F);
  61
  62 my $obj2 = F->new;
  63
  64 print join(", ", @{$obj2->order}),"\n";
  65 is_deeply $obj2->order, [qw(D E F)], "immutable BUILD invocation order still correct";
  66
  67