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