1#!perl 2 3use strict; 4use warnings; 5use constant HAS_THREADS => eval{ require threads && require threads::shared }; 6use Test::More; 7 8use if !HAS_THREADS, 'Test::More', 9 (skip_all => "This is a test for threads ($@)"); 10use if $Test::More::VERSION >= 2.00, 'Test::More', 11 (skip_all => "Test::Builder2 has bugs about threads"); 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 has bar => ( 25 is => 'rw', 26 27 lazy => 1, 28 default => sub { 42 }, 29 ); 30 31 package Foo; 32 use Mouse; 33 34 has value => ( 35 is => 'rw', 36 isa => 'Int', 37 38 traits => [qw(MyTraits)], 39 ); 40} 41pass; 42 43my $o = MyClass->new(foo => Foo->new(value => 42)); 44threads->create(sub{ 45 my $x = MyClass->new(foo => Foo->new(value => 1)); 46 is $x->foo->value, 1; 47 48 $x->foo(Foo->new(value => 2)); 49 50 is $x->foo->value, 2; 51 52 MyClass->meta->make_immutable(); 53 54 $x = MyClass->new(foo => Foo->new(value => 10)); 55 is $x->foo->value, 10; 56 57 $x->foo(Foo->new(value => 20)); 58 59 is $x->foo->value, 20; 60 61 is $x->bar, 42, 'callback for default'; 62})->join(); 63 64is $o->foo->value, 42; 65 66$o = MyClass->new(foo => Foo->new(value => 43)); 67is $o->foo->value, 43; 68 69ok !$o->meta->is_immutable; 70 71pass "done"; 72 73done_testing; 74