Add a failing test for RT #69237 (lazy+threads)
[gitmo/Mouse.git] / t / 001_mouse / 060-threads.t
CommitLineData
f259aaad 1#!perl
2use strict;
3use warnings;
652b2a97 4use constant HAS_THREADS => eval{ require threads && require threads::shared };
20a12328 5use Test::More;
f259aaad 6
dc5cf9ef 7use if !HAS_THREADS, 'Test::More',
8 (skip_all => "This is a test for threads ($@)");
95637edb 9use if $Test::More::VERSION >= 2.00, 'Test::More',
10 (skip_all => "Test::Builder2 has bugs about threads");
dc5cf9ef 11
f259aaad 12{
20a12328 13 package MyTraits;
14 use Mouse::Role;
15
f259aaad 16 package MyClass;
17 use Mouse;
18
19 has foo => (
20 is => 'rw',
aff73a9e 21 isa => 'Foo',
22 );
c4988b33 23 has bar => (
24 is => 'rw',
25
26 lazy => 1,
27 default => sub { 42 },
28 );
aff73a9e 29
30 package Foo;
31 use Mouse;
32
33 has value => (
34 is => 'rw',
20a12328 35 isa => 'Int',
36
37 traits => [qw(MyTraits)],
f259aaad 38 );
39}
9e69967c 40pass;
f259aaad 41
aff73a9e 42my $o = MyClass->new(foo => Foo->new(value => 42));
f259aaad 43threads->create(sub{
aff73a9e 44 my $x = MyClass->new(foo => Foo->new(value => 1));
45 is $x->foo->value, 1;
f259aaad 46
aff73a9e 47 $x->foo(Foo->new(value => 2));
f259aaad 48
aff73a9e 49 is $x->foo->value, 2;
f259aaad 50
51 MyClass->meta->make_immutable();
52
aff73a9e 53 $x = MyClass->new(foo => Foo->new(value => 10));
54 is $x->foo->value, 10;
f259aaad 55
aff73a9e 56 $x->foo(Foo->new(value => 20));
f259aaad 57
aff73a9e 58 is $x->foo->value, 20;
c4988b33 59
60 is $x->bar, 42, 'callback for default';
f259aaad 61})->join();
62
aff73a9e 63is $o->foo->value, 42;
20a12328 64
65$o = MyClass->new(foo => Foo->new(value => 43));
66is $o->foo->value, 43;
67
f259aaad 68ok !$o->meta->is_immutable;
69
dc5cf9ef 70pass "done";
71
20a12328 72done_testing;