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