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, 'Test::More',
  10     (skip_all => "Test::Builder2 has bugs about threads");
  11
  12 {
  13     package MyTraits;
  14     use Mouse::Role;
  15
  16     package MyClass;
  17     use Mouse;
  18
  19     has foo => (
  20         is => 'rw',
  21         isa => 'Foo',
  22     );
  23
  24     package Foo;
  25     use Mouse;
  26
  27     has value => (
  28         is => 'rw',
  29         isa => 'Int',
  30
  31         traits => [qw(MyTraits)],
  32     );
  33 }
  34 pass;
  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;