Add a DB::sub test to xt/
[gitmo/Mouse.git] / t / 001_mouse / 060-threads.t
1 #!perl
2 use strict;
3 use warnings;
4 use constant HAS_THREADS => eval{ require threads };
5
6 use Test::More HAS_THREADS ? (tests => 6) : (skip_all => "This is a test for threads ($@)");
7
8 {
9     package MyClass;
10     use Mouse;
11
12     has foo => (
13         is => 'rw',
14         isa => 'Foo',
15     );
16
17     package Foo;
18     use Mouse;
19
20     has value => (
21         is => 'rw',
22     );
23 }
24
25 my $o = MyClass->new(foo => Foo->new(value => 42));
26 threads->create(sub{
27     my $x = MyClass->new(foo => Foo->new(value => 1));
28     is $x->foo->value, 1;
29
30     $x->foo(Foo->new(value => 2));
31
32     is $x->foo->value, 2;
33
34     MyClass->meta->make_immutable();
35
36     $x = MyClass->new(foo => Foo->new(value => 10));
37     is $x->foo->value, 10;
38
39     $x->foo(Foo->new(value => 20));
40
41     is $x->foo->value, 20;
42 })->join();
43
44 is $o->foo->value, 42;
45 ok !$o->meta->is_immutable;
46