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 Moose::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 Moose;
  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 = Moose::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'        , "correct value for 'foos'  before inlining constructor");
  38   is(Foo->new->bars, 'many bars'        , "correct value for 'bars'  before inlining constructor");
  39   is(Foo->new->bazes, 'many bazes'      , "correct value for 'bazes' before inlining constructor");
  40   lives_ok{ $meta->make_immutable       } "Foo is imutable";
  41   lives_ok{ $meta->identifier           } "->identifier on metaclass lives";
  42   dies_ok{  $meta->add_role($foo_role)  } "Add Role is locked";
  43   lives_ok{ Foo->new                    } "Inlined constructor works with lazy_build";
  44   is(Foo->new->foos, 'many foos'        , "correct value for 'foos'  after inlining constructor");
  45   is(Foo->new->bars, 'many bars'        , "correct value for 'bars'  after inlining constructor");
  46   is(Foo->new->bazes, 'many bazes'      , "correct value for 'bazes' after inlining constructor");
  47   lives_ok{ $meta->make_mutable         } "Foo is mutable";
  48   lives_ok{ $meta->add_role($foo_role)  } "Add Role is unlocked";
  49
  50
  51 }
  52
  53 {
  54   package Bar;
  55
  56   use Moose;
  57
  58   sub BUILD { 'bar' }
  59 }
  60
  61 {
  62   package Baz;
  63
  64   use Moose;
  65
  66   extends 'Bar';
  67
  68   sub BUILD { 'baz' }
  69 }
  70
  71 lives_ok { Bar->meta->make_immutable }
  72   'Immutable meta with single BUILD';
  73
  74 lives_ok { Baz->meta->make_immutable }
  75   'Immutable meta with multiple BUILDs';
  76
  77 =pod
  78
  79 Nothing here yet, but soon :)
  80
  81 =cut