t/001_mouse/060-threads.t

   1 #!perl
   2 use strict;
   3 use warnings;
   4 use constant HAS_THREADS => eval{ require threads && require threads::shared };
   5 use Test::More;
   6
   7 use if !HAS_THREADS, 'Test::More',
   8     (skip_all => "This is a test for threads ($@)");
   9 use if $Test::More::VERSION == 2.00_01, 'Test::More',
  10     (skip_all => "Test::Builder2 2.00_01 has bugs about threads");
  11
  12
  13 {
  14     package MyTraits;
  15     use Mouse::Role;
  16
  17     package MyClass;
  18     use Mouse;
  19
  20     has foo => (
  21         is => 'rw',
  22         isa => 'Foo',
  23     );
  24
  25     package Foo;
  26     use Mouse;
  27
  28     has value => (
  29         is => 'rw',
  30         isa => 'Int',
  31
  32         traits => [qw(MyTraits)],
  33     );
  34 }
  35
  36 my $o = MyClass->new(foo => Foo->new(value => 42));
  37 threads->create(sub{
  38     my $x = MyClass->new(foo => Foo->new(value => 1));
  39     is $x->foo->value, 1;
  40
  41     $x->foo(Foo->new(value => 2));
  42
  43     is $x->foo->value, 2;
  44
  45     MyClass->meta->make_immutable();
  46
  47     $x = MyClass->new(foo => Foo->new(value => 10));
  48     is $x->foo->value, 10;
  49
  50     $x->foo(Foo->new(value => 20));
  51
  52     is $x->foo->value, 20;
  53 })->join();
  54
  55 is $o->foo->value, 42;
  56
  57 $o = MyClass->new(foo => Foo->new(value => 43));
  58 is $o->foo->value, 43;
  59
  60 ok !$o->meta->is_immutable;
  61
  62 pass "done";
  63
  64 done_testing;