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 pass 'dummy test for Test::Builder 2.00_06';
  13
  14 {
  15     package MyTraits;
  16     use Mouse::Role;
  17
  18     package MyClass;
  19     use Mouse;
  20
  21     has foo => (
  22         is => 'rw',
  23         isa => 'Foo',
  24     );
  25
  26     package Foo;
  27     use Mouse;
  28
  29     has value => (
  30         is => 'rw',
  31         isa => 'Int',
  32
  33         traits => [qw(MyTraits)],
  34     );
  35 }
  36 pass;
  37
  38 my $o = MyClass->new(foo => Foo->new(value => 42));
  39 threads->create(sub{
  40     my $x = MyClass->new(foo => Foo->new(value => 1));
  41     is $x->foo->value, 1;
  42
  43     $x->foo(Foo->new(value => 2));
  44
  45     is $x->foo->value, 2;
  46
  47     MyClass->meta->make_immutable();
  48
  49     $x = MyClass->new(foo => Foo->new(value => 10));
  50     is $x->foo->value, 10;
  51
  52     $x->foo(Foo->new(value => 20));
  53
  54     is $x->foo->value, 20;
  55 })->join();
  56
  57 is $o->foo->value, 42;
  58
  59 $o = MyClass->new(foo => Foo->new(value => 43));
  60 is $o->foo->value, 43;
  61
  62 ok !$o->meta->is_immutable;
  63
  64 pass "done";
  65
  66 done_testing;