t/300_immutable/010_constructor_is_not_moose.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7
   8 eval "use Test::Output";
   9 plan skip_all => "Test::Output is required for this test" if $@;
  10
  11 plan tests => 5;
  12
  13 {
  14     package NotMoose;
  15
  16     sub new {
  17         my $class = shift;
  18
  19         return bless { not_moose => 1 }, $class;
  20     }
  21 }
  22
  23 {
  24     package Foo;
  25     use Moose;
  26
  27     extends 'NotMoose';
  28
  29     ::stderr_is(
  30         sub { Foo->meta->make_immutable },
  31         "Not inlining a constructor for Foo since it is not inheriting the default Moose::Object constructor\n",
  32         'got a warning that Foo may not have an inlined constructor'
  33     );
  34 }
  35
  36 is(
  37     Foo->meta->find_method_by_name('new')->body,
  38     NotMoose->can('new'),
  39     'Foo->new is inherited from NotMoose'
  40 );
  41
  42 {
  43     package Bar;
  44     use Moose;
  45
  46     extends 'NotMoose';
  47
  48     ::stderr_is(
  49         sub { Foo->meta->make_immutable( replace_constructor => 1 ) },
  50         q{},
  51         'no warning when replace_constructor is true'
  52     );
  53 }
  54
  55 isnt(
  56     Bar->meta->find_method_by_name('new')->body,
  57     Moose::Object->can('new'),
  58     'Bar->new is not inherited from NotMoose because it was inlined'
  59 );
  60
  61 {
  62     package Baz;
  63     use Moose;
  64
  65     Baz->meta->make_immutable;
  66 }
  67
  68 {
  69     package Quux;
  70     use Moose;
  71
  72     extends 'Baz';
  73
  74     ::stderr_is(
  75         sub { Quux->meta->make_immutable },
  76         q{},
  77         'no warning when inheriting from a class that has already made itself immutable'
  78     );
  79 }