t/300_immutable/001_immutable_moose.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Fatal;
   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     is( exception { Foo->new }, undef, "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     is( exception { $meta->make_immutable }, undef, "Foo is imutable" );
  44     is( exception { $meta->identifier }, undef, "->identifier on metaclass lives" );
  45     isnt( exception { $meta->add_role($foo_role) }, undef, "Add Role is locked" );
  46     is( exception { Foo->new }, undef, "Inlined constructor works with lazy_build" );
  47     is( Foo->new->foos, 'many foos',
  48         "correct value for 'foos'  after inlining constructor" );
  49     is( Foo->new->bars, 'many bars',
  50         "correct value for 'bars'  after inlining constructor" );
  51     is( Foo->new->bazes, 'many bazes',
  52         "correct value for 'bazes' after inlining constructor" );
  53     is( exception { $meta->make_mutable }, undef, "Foo is mutable" );
  54     is( exception { $meta->add_role($foo_role) }, undef, "Add Role is unlocked" );
  55
  56 }
  57
  58 {
  59   package Bar;
  60
  61   use Moose;
  62
  63   sub BUILD { 'bar' }
  64 }
  65
  66 {
  67   package Baz;
  68
  69   use Moose;
  70
  71   extends 'Bar';
  72
  73   sub BUILD { 'baz' }
  74 }
  75
  76 is( exception { Bar->meta->make_immutable }, undef, 'Immutable meta with single BUILD' );
  77
  78 is( exception { Baz->meta->make_immutable }, undef, 'Immutable meta with multiple BUILDs' );
  79
  80 =pod
  81
  82 Nothing here yet, but soon :)
  83
  84 =cut
  85
  86 done_testing;