t/immutable/inline_fallbacks.t

   1 use strict;
   2 use warnings;
   3 use Test::More;
   4
   5 {
   6     package Foo;
   7     use Moose;
   8     has foo => (is => 'ro');
   9 }
  10
  11 {
  12     package Foo::Sub;
  13     use Moose;
  14     extends 'Foo';
  15     has bar => (is => 'ro');
  16 }
  17
  18 {
  19     my $foo = Foo::Sub->new(foo => 12, bar => 25);
  20     is($foo->foo, 12, 'got right value for foo');
  21     is($foo->bar, 25, 'got right value for bar');
  22 }
  23
  24 Foo->meta->make_immutable;
  25
  26 {
  27     package Foo::Sub2;
  28     use Moose;
  29     extends 'Foo';
  30     has baz => (is => 'ro');
  31     # not making immutable, inheriting Foo's inlined constructor
  32 }
  33
  34 {
  35     my $foo = Foo::Sub2->new(foo => 42, baz => 27);
  36     is($foo->foo, 42, 'got right value for foo');
  37     is($foo->baz, 27, 'got right value for baz');
  38 }
  39
  40 my $BAR = 0;
  41 {
  42     package Bar;
  43     use Moose;
  44 }
  45
  46 {
  47     package Bar::Sub;
  48     use Moose;
  49     extends 'Bar';
  50     sub DEMOLISH { $BAR++ }
  51 }
  52
  53 Bar::Sub->new;
  54 is($BAR, 1, 'DEMOLISH in subclass was called');
  55 $BAR = 0;
  56
  57 Bar->meta->make_immutable;
  58
  59 {
  60     package Bar::Sub2;
  61     use Moose;
  62     extends 'Bar';
  63     sub DEMOLISH { $BAR++ }
  64     # not making immutable, inheriting Bar's inlined destructor
  65 }
  66
  67 Bar::Sub2->new;
  68 is($BAR, 1, 'DEMOLISH in subclass was called');
  69
  70 done_testing;