t/300_immutable/006_immutable_nonmoose_subclass.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 10;
   7 use Test::Exception;
   8 use Scalar::Util 'blessed';
   9
  10 BEGIN {
  11     use_ok('Moose');
  12     use_ok('Moose::Meta::Role');
  13 }
  14
  15 =pod
  16
  17 This test it kind of odd, it tests
  18 to see if make_immutable will DWIM
  19 when pressented with a class that
  20 inherits from a non-Moose base class.
  21
  22 Since immutable only affects the local
  23 class, and if it doesnt find a constructor
  24 it will always create one, it won't
  25 discover this issue, and it will ignore
  26 the inherited constructor.
  27
  28 This is not really the desired way, but
  29 detecting this opens a big can of worms
  30 which we are not going to deal with just
  31 yet (eventually yes, but most likely it
  32 will be when we have MooseX::Compile
  33 available and working).
  34
  35 In the meantime, just know that when you
  36 call make_immutable on a class which
  37 inherits from a non-Moose class, you
  38 should add (inline_constructor => 0).
  39
  40 Sorry Sartak.
  41
  42 =cut
  43
  44 {
  45     package Grandparent;
  46
  47     sub new {
  48         my $class = shift;
  49         my %args  = (
  50             grandparent => 'gramma',
  51             @_,
  52         );
  53
  54         bless \%args => $class;
  55     }
  56
  57     sub grandparent { 1 }
  58 }
  59
  60 {
  61     package Parent;
  62     use Moose;
  63     extends 'Grandparent';
  64
  65     around new => sub {
  66         my $orig  = shift;
  67         my $class = shift;
  68
  69         $class->$orig(
  70             parent => 'mama',
  71             @_,
  72         );
  73     };
  74
  75     sub parent { 1 }
  76 }
  77
  78 {
  79     package Child;
  80     use Moose;
  81     extends 'Parent';
  82
  83     sub child { 1 }
  84
  85     make_immutable;
  86 }
  87
  88 is(blessed(Grandparent->new), "Grandparent", "got a Grandparent object out of Grandparent->new");
  89 is(blessed(Parent->new), "Parent", "got a Parent object out of Parent->new");
  90 is(blessed(Child->new), "Child", "got a Child object out of Child->new");
  91
  92 is(Child->new->grandparent, 1, "Child responds to grandparent");
  93 is(Child->new->parent, 1, "Child responds to parent");
  94 is(Child->new->child, 1, "Child responds to child");
  95
  96 is(Child->new->{grandparent}, undef, "didnt create a value, cause immutable overode the constructor");
  97 is(Child->new->{parent}, undef, "didnt create a value, cause immutable overode the constructor");
  98
  99