t/300_immutable/016_immutable_with_mutable_ancestors.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Exception;
   8 use lib 't/lib';
   9
  10 BEGIN {
  11     eval "use Test::Output;";
  12     plan skip_all => "Test::Output is required for this test" if $@;
  13     plan tests => 5;
  14 }
  15
  16 {
  17     package Foo;
  18     use Moose;
  19 }
  20
  21 {
  22     package Foo::Sub;
  23     use Moose;
  24     extends 'Foo';
  25
  26     ::stderr_like {
  27         __PACKAGE__->meta->make_immutable
  28     } qr/^Calling make_immutable on Foo::Sub, which has a mutable ancestor \(Foo\)/,
  29       "warning when making a class with mutable ancestors immutable";
  30 }
  31
  32 Foo->meta->make_immutable;
  33
  34 {
  35     package Foo::Sub2;
  36     use Moose;
  37     extends 'Foo';
  38
  39     ::stderr_is {
  40         __PACKAGE__->meta->make_immutable
  41     } '', "no warning when all ancestors are immutable";
  42 }
  43
  44 {
  45     package Foo::Sub3;
  46     use Moose;
  47     extends 'Foo';
  48 }
  49
  50 {
  51     package Foo::Sub3::Sub;
  52     use Moose;
  53     extends 'Foo::Sub3';
  54 }
  55
  56 {
  57     package Foo::Sub3::Sub::Sub;
  58     use Moose;
  59     extends 'Foo::Sub3::Sub';
  60
  61     ::stderr_like {
  62         __PACKAGE__->meta->make_immutable
  63     } qr/^Calling make_immutable on Foo::Sub3::Sub::Sub, which has a mutable ancestor \(Foo::Sub3::Sub\)/,
  64       "warning when making a class with mutable ancestors immutable";
  65 }
  66
  67 stderr_like {
  68     require Recursive::Parent
  69 } qr/^Calling make_immutable on Recursive::Child, which has a mutable ancestor \(Recursive::Parent\)/,
  70   "circular dependencies via use are caught properly";
  71
  72 {
  73     package Base::Role;
  74     use Moose::Role;
  75
  76     sub foo { 42 }
  77
  78     package Bar;
  79     use Moose;
  80     use Moose::Util::MetaRole;
  81
  82     Moose::Util::MetaRole::apply_base_class_roles(
  83         for_class => __PACKAGE__,
  84         roles     => ['Base::Role'],
  85     );
  86
  87     ::stderr_is {
  88         __PACKAGE__->meta->make_immutable
  89     } '', "no warning when ancestor is a base-class role subclass of Moose::Object";
  90 }