Improve tests for threads
gfx [Sun, 20 Dec 2009 06:57:54 +0000 (15:57 +0900)]
t/001_mouse/060-threads.t

index 06748db..812af2b 100644 (file)
@@ -3,7 +3,7 @@ use strict;
 use warnings;
 use constant HAS_THREADS => eval{ require threads };
 
-use Test::More HAS_THREADS ? (tests => 6) : (skip_all => "This is a test for threads ($@)");
+use Test::More HAS_THREADS ? (tests => 32) : (skip_all => "This is a test for threads ($@)");
 
 {
     package MyClass;
@@ -16,30 +16,53 @@ use Test::More HAS_THREADS ? (tests => 6) : (skip_all => "This is a test for thr
 
     package Foo;
     use Mouse;
+    extends qw(MyClass);
 
     has value => (
-        is => 'rw',
+        is  => 'rw',
+        isa => 'Int',
     );
 }
 
+sub mysleep {
+    select undef, undef, undef, $_[0];
+}\r
+
+
 my $o = MyClass->new(foo => Foo->new(value => 42));
-threads->create(sub{
-    my $x = MyClass->new(foo => Foo->new(value => 1));
-    is $x->foo->value, 1;
 
-    $x->foo(Foo->new(value => 2));
+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;
 
-    is $x->foo->value, 2;
+        mysleep(0.01);
 
-    MyClass->meta->make_immutable();
+        $x->foo(Foo->new(value => 2));
 
-    $x = MyClass->new(foo => Foo->new(value => 10));
-    is $x->foo->value, 10;
+        is $x->foo->value, 2;
 
-    $x->foo(Foo->new(value => 20));
+        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)";
+    });
+}
 
-    is $x->foo->value, 20;
-})->join();
+$_->join for @threads;
 
 is $o->foo->value, 42;
 ok !$o->meta->is_immutable;