Moose-t-failing/300_immutable/010_constructor_is_not_moose.t

   1 #!/usr/bin/perl
   2 # This is automatically generated by author/import-moose-test.pl.
   3 # DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
   4 use t::lib::MooseCompat;
   5
   6 use strict;
   7 use warnings;
   8
   9 use Test::More;
  10 $TODO = q{Mouse is not yet completed};
  11
  12 use Test::Requires {
  13     'Test::Output' => '0.01', # skip all if not installed
  14 };
  15
  16 {
  17     package NotMouse;
  18
  19     sub new {
  20         my $class = shift;
  21
  22         return bless { not_moose => 1 }, $class;
  23     }
  24 }
  25
  26 {
  27     package Foo;
  28     use Mouse;
  29
  30     extends 'NotMouse';
  31
  32     ::stderr_like(
  33         sub { Foo->meta->make_immutable },
  34         qr/\QNot inlining 'new' for Foo since it is not inheriting the default Mouse::Object::new\E\s+\QIf you are certain you don't need to inline your constructor, specify inline_constructor => 0 in your call to Foo->meta->make_immutable/,
  35         'got a warning that Foo may not have an inlined constructor'
  36     );
  37 }
  38
  39 is(
  40     Foo->meta->find_method_by_name('new')->body,
  41     NotMouse->can('new'),
  42     'Foo->new is inherited from NotMouse'
  43 );
  44
  45 {
  46     package Bar;
  47     use Mouse;
  48
  49     extends 'NotMouse';
  50
  51     ::stderr_is(
  52         sub { Bar->meta->make_immutable( replace_constructor => 1 ) },
  53         q{},
  54         'no warning when replace_constructor is true'
  55     );
  56 }
  57
  58 is(
  59     Bar->meta->find_method_by_name('new')->package_name,
  60    'Bar',
  61     'Bar->new is inlined, and not inherited from NotMouse'
  62 );
  63
  64 {
  65     package Baz;
  66     use Mouse;
  67
  68     Baz->meta->make_immutable;
  69 }
  70
  71 {
  72     package Quux;
  73     use Mouse;
  74
  75     extends 'Baz';
  76
  77     ::stderr_is(
  78         sub { Quux->meta->make_immutable },
  79         q{},
  80         'no warning when inheriting from a class that has already made itself immutable'
  81     );
  82 }
  83
  84 {
  85     package My::Constructor;
  86     use base 'Mouse::Meta::Method';
  87 }
  88
  89 {
  90     package CustomCons;
  91     use Mouse;
  92
  93     CustomCons->meta->make_immutable( constructor_class => 'My::Constructor' );
  94 }
  95
  96 {
  97     package Subclass;
  98     use Mouse;
  99
 100     extends 'CustomCons';
 101
 102     ::stderr_is(
 103         sub { Subclass->meta->make_immutable },
 104         q{},
 105         'no warning when inheriting from a class that has already made itself immutable'
 106     );
 107 }
 108
 109 done_testing;