Improve tests for threads

[gitmo/Mouse.git] / t / 001_mouse / 060-threads.t

#!perl
use strict;
use warnings;
use constant HAS_THREADS => eval{ require threads };

use Test::More HAS_THREADS ? (tests => 32) : (skip_all => "This is a test for threads ($@)");

{
    package MyClass;
    use Mouse;

    has foo => (
        is => 'rw',
        isa => 'Foo',
    );

    package Foo;
    use Mouse;
    extends qw(MyClass);

    has value => (
        is  => 'rw',
        isa => 'Int',
    );
}

sub mysleep {
    select undef, undef, undef, $_[0];
}\r


my $o = MyClass->new(foo => Foo->new(value => 42));

my @threads;

foreach (1 .. 5){
    push @threads, threads->create(sub{
        my $tid = threads->tid;

        ok($tid, "start (tid: $tid)");

        my $x = MyClass->new(foo => Foo->new(value => 1));
        is $x->foo->value, 1;

        mysleep(0.01);

        $x->foo(Foo->new(value => 2));

        is $x->foo->value, 2;

        MyClass->meta->make_immutable();
        Foo->meta->make_immutable();

        my $y = MyClass->new(foo => Foo->new(value => 10));
        is $y->foo->value, 10;

        $y->foo(Foo->new(value => 20));

        is $y->foo->value, 20;

        is $x->foo->value, 2, "end (tid: $tid)";
    });
}

$_->join for @threads;

is $o->foo->value, 42;
ok !$o->meta->is_immutable;