t/300_immutable/001_immutable_moose.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 15;
   7 use Test::Exception;
   8
   9 use Mouse::Meta::Role;
  10
  11
  12 {
  13     package FooRole;
  14     our $VERSION = '0.01';
  15     sub foo {'FooRole::foo'}
  16 }
  17
  18 {
  19     package Foo;
  20     use Mouse;
  21
  22     #two checks because the inlined methods are different when
  23     #there is a TC present.
  24     has 'foos' => ( is => 'ro', lazy_build => 1 );
  25     has 'bars' => ( isa => 'Str', is => 'ro', lazy_build => 1 );
  26     has 'bazes' => ( isa => 'Str', is => 'ro', builder => '_build_bazes' );
  27     sub _build_foos  {"many foos"}
  28     sub _build_bars  {"many bars"}
  29     sub _build_bazes {"many bazes"}
  30 }
  31
  32 {
  33     my $foo_role = Mouse::Meta::Role->initialize('FooRole');
  34     my $meta     = Foo->meta;
  35
  36     lives_ok { Foo->new } "lazy_build works";
  37     is( Foo->new->foos, 'many foos',
  38         "correct value for 'foos'  before inlining constructor" );
  39     is( Foo->new->bars, 'many bars',
  40         "correct value for 'bars'  before inlining constructor" );
  41     is( Foo->new->bazes, 'many bazes',
  42         "correct value for 'bazes' before inlining constructor" );
  43     lives_ok { $meta->make_immutable } "Foo is imutable";
  44     SKIP: {
  45         skip "Mouse doesn't supports ->identifier, add_role", 2;
  46         lives_ok { $meta->identifier } "->identifier on metaclass lives";
  47         dies_ok { $meta->add_role($foo_role) } "Add Role is locked";
  48     };
  49     lives_ok { Foo->new } "Inlined constructor works with lazy_build";
  50     is( Foo->new->foos, 'many foos',
  51         "correct value for 'foos'  after inlining constructor" );
  52     is( Foo->new->bars, 'many bars',
  53         "correct value for 'bars'  after inlining constructor" );
  54     is( Foo->new->bazes, 'many bazes',
  55         "correct value for 'bazes' after inlining constructor" );
  56     SKIP: {
  57         skip "Mouse doesn't supports make_mutable", 2;
  58         lives_ok { $meta->make_mutable } "Foo is mutable";
  59         lives_ok { $meta->add_role($foo_role) } "Add Role is unlocked";
  60     };
  61
  62 }
  63
  64 {
  65   package Bar;
  66
  67   use Mouse;
  68
  69   sub BUILD { 'bar' }
  70 }
  71
  72 {
  73   package Baz;
  74
  75   use Mouse;
  76
  77   extends 'Bar';
  78
  79   sub BUILD { 'baz' }
  80 }
  81
  82 lives_ok { Bar->meta->make_immutable }
  83   'Immutable meta with single BUILD';
  84
  85 lives_ok { Baz->meta->make_immutable }
  86   'Immutable meta with multiple BUILDs';
  87
  88 =pod
  89
  90 Nothing here yet, but soon :)
  91
  92 =cut