t/800_shikabased/003-make_immutable.t

   1 use strict;
   2 use warnings;
   3 use Test::More tests => 18;
   4 use Test::Exception;
   5 use Scalar::Util qw/isweak/;
   6
   7 {
   8     package Headers;
   9     use Mouse;
  10     has data => (
  11         is => 'rw',
  12         isa => 'Str',
  13     );
  14     no Mouse;
  15 }
  16
  17 {
  18     package Types;
  19     use MouseX::Types -declare => [qw/Foo/];
  20     use MouseX::Types::Mouse 'HashRef';
  21     class_type Foo, { class => 'Headers' };
  22     coerce Foo,
  23         from HashRef,
  24         via {
  25         Headers->new($_);
  26     };
  27 }
  28
  29
  30 &main; exit;
  31
  32 sub construct {
  33     my $class = shift;
  34     eval <<"...";
  35     package $class;
  36     use Mouse;
  37     BEGIN { Types->import('Foo') }
  38     has bone => (
  39         is => 'rw',
  40         required => 1,
  41     );
  42     has foo => (
  43         is     => 'rw',
  44         isa    => Foo,
  45         coerce => 1,
  46     );
  47     has weak_foo => (
  48         is       => 'rw',
  49         weak_ref => 1,
  50     );
  51     has trigger_foo => (
  52         is => 'rw',
  53         trigger => sub { \$_[0]->bone('eat') },
  54     );
  55     sub BUILD { main::ok "calling BUILD in SoftDog" }
  56     no Mouse;
  57 ...
  58     die $@ if $@;
  59 }
  60
  61 sub test {
  62     my $class = shift;
  63     lives_ok { $class->new(bone => 'moo') } "$class new";
  64     throws_ok { $class->new() } qr/\QAttribute (bone) is required/;
  65     is($class->new(bone => 'moo', foo => { data => 3 })->foo->data, 3);
  66
  67     my $foo = Headers->new();
  68     ok(Scalar::Util::isweak($class->new(bone => 'moo', weak_foo => $foo)->{weak_foo}));
  69
  70     {
  71         my $o = $class->new(bone => 'moo');
  72         $o->trigger_foo($foo);
  73         is($o->bone, 'eat');
  74     }
  75 }
  76
  77 sub main {
  78     construct('SoftDog');
  79     test('SoftDog');
  80
  81     construct('HardDog');
  82     HardDog->meta->make_immutable;
  83     test('HardDog');
  84 }
  85