Perl RT #122761 - split /\A/ should not behave like split /^/m
[perl.git] / lib / Thread.t
1 use strict;
2 use warnings;
3
4 BEGIN {
5     chdir 't' if -d 't';
6     @INC = '../lib';
7
8     use Config;
9     if (! $Config{usethreads}) {
10         print("1..0 # Skip: No threads\n");
11         exit(0);
12     }
13 }
14
15 use Thread qw(:DEFAULT async yield);
16
17 use Test::More tests => 13;
18
19 my $lock;
20 {
21     no warnings 'once';
22     if ($threads::shared::threads_shared) {
23         &threads::shared::share(\$lock);
24     }
25 }
26
27
28 BASIC:
29 {
30     sub thr_sub
31     {
32         lock($lock);
33         my $self = Thread->self;
34         return $self->tid;
35     }
36
37     my $thr;
38     {
39         lock($lock);
40
41         $thr = Thread->new(\&thr_sub);
42
43         isa_ok($thr, 'Thread');
44
45         ok(! $thr->done(), 'Thread running');
46         is($thr->tid, 1, "thread's tid");
47
48         my ($thr2) = Thread->list;
49         ok($thr2->equal($thr), '->list returned thread');
50     }
51     yield();
52     sleep(1);
53
54     ok($thr->done(), 'Thread done');
55     is($thr->join(), 1, "->join returned thread's tid");
56 }
57
58 ASYNC:
59 {
60     my $thr = async { Thread->self->tid; };
61     isa_ok($thr, 'Thread');
62     is($thr->tid, 2, "async thread's tid");
63     is($thr->join, 2, "->join on async returned tid");
64 }
65
66 COND_:
67 {
68     sub thr_wait
69     {
70         lock($lock);
71         cond_wait($lock);
72         return Thread->self->tid;
73     }
74
75     my $thr;
76     {
77         lock($lock);
78         $thr = Thread->new(\&thr_wait);
79         isa_ok($thr, 'Thread');
80         ok(! $thr->done(), 'Thread running');
81     }
82     yield();
83     sleep(1);
84
85     {
86         lock($lock);
87         cond_signal($lock);
88     }
89     yield();
90     sleep(1);
91
92     ok($thr->done(), 'Thread done');
93     is($thr->join(), 3, "->join returned thread's tid");
94 }
95
96 # EOF