t/todo_tests/immutable_n_around.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7
   8 # if make_immutable is removed from the following code the tests pass
   9
  10 {
  11     package Foo;
  12     use Moose;
  13
  14     has foo => ( is => "ro" );
  15
  16     package Bar;
  17     use Moose;
  18
  19     extends qw(Foo);
  20
  21     around new => sub {
  22         my $next = shift;
  23         my ( $self, @args ) = @_;
  24         $self->$next( foo => 42 );
  25     };
  26
  27     package Gorch;
  28     use Moose;
  29
  30     extends qw(Bar);
  31
  32     package Zoink;
  33     use Moose;
  34
  35     extends qw(Gorch);
  36
  37 }
  38
  39 my @classes = qw(Foo Bar Gorch Zoink);
  40
  41 tests: {
  42     is( Foo->new->foo, undef, "base class (" . (Foo->meta->is_immutable ? "immutable" : "mutable") . ")" );
  43     is( Bar->new->foo, 42, "around new called on Bar->new (" . (Bar->meta->is_immutable ? "immutable" : "mutable") . ")"  );
  44     is( Gorch->new->foo, 42, "around new called on Gorch->new (" . (Gorch->meta->is_immutable ? "immutable" : "mutable") . ")"  );
  45     is( Zoink->new->foo, 42, "around new called Zoink->new (" . (Zoink->meta->is_immutable ? "immutable" : "mutable") . ")"  );
  46
  47     if ( @classes ) {
  48         local $SIG{__WARN__} = sub {};
  49         ( shift @classes )->meta->make_immutable;
  50         redo tests;
  51     }
  52 }
  53
  54 done_testing;