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     has bar => (
  24         is => 'rw',
  25
  26         lazy    => 1,
  27         default => sub { 42 },
  28     );
  29
  30     package Foo;
  31     use Mouse;
  32
  33     has value => (
  34         is => 'rw',
  35         isa => 'Int',
  36
  37         traits => [qw(MyTraits)],
  38     );
  39 }
  40 pass;
  41
  42 my $o = MyClass->new(foo => Foo->new(value => 42));
  43 threads->create(sub{
  44     my $x = MyClass->new(foo => Foo->new(value => 1));
  45     is $x->foo->value, 1;
  46
  47     $x->foo(Foo->new(value => 2));
  48
  49     is $x->foo->value, 2;
  50
  51     MyClass->meta->make_immutable();
  52
  53     $x = MyClass->new(foo => Foo->new(value => 10));
  54     is $x->foo->value, 10;
  55
  56     $x->foo(Foo->new(value => 20));
  57
  58     is $x->foo->value, 20;
  59
  60     is $x->bar, 42, 'callback for default';
  61 })->join();
  62
  63 is $o->foo->value, 42;
  64
  65 $o = MyClass->new(foo => Foo->new(value => 43));
  66 is $o->foo->value, 43;
  67
  68 ok !$o->meta->is_immutable;
  69
  70 pass "done";
  71
  72 done_testing;