This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
From #43633: Cwd::cwd() use in File::Spec::Unix use causes unnecessary fork()
[perl5.git] / ext / threads / t / basic.t
1 use strict;
2 use warnings;
3
4 BEGIN {
5     if ($ENV{'PERL_CORE'}){
6         chdir 't';
7         unshift @INC, '../lib';
8     }
9     use Config;
10     if (! $Config{'useithreads'}) {
11         print("1..0 # Skip: Perl not compiled with 'useithreads'\n");
12         exit(0);
13     }
14 }
15
16 use ExtUtils::testlib;
17
18 sub ok {
19     my ($id, $ok, $name) = @_;
20
21     # You have to do it this way or VMS will get confused.
22     if ($ok) {
23         print("ok $id - $name\n");
24     } else {
25         print("not ok $id - $name\n");
26         printf("# Failed test at line %d\n", (caller)[2]);
27     }
28
29     return ($ok);
30 }
31
32 BEGIN {
33     $| = 1;
34     print("1..33\n");   ### Number of tests that will be run ###
35 };
36
37 use threads;
38
39 if ($threads::VERSION && ! exists($ENV{'PERL_CORE'})) {
40     print(STDERR "# Testing threads $threads::VERSION\n");
41 }
42
43 ok(1, 1, 'Loaded');
44
45 ### Start of Testing ###
46
47 ok(2, 1 == $threads::threads, "Check that threads::threads is true");
48
49 sub test1 {
50     ok(3,'bar' eq $_[0], "Test that argument passing works");
51 }
52 threads->create('test1', 'bar')->join();
53
54 sub test2 {
55     ok(4,'bar' eq $_[0]->[0]->{'foo'}, "Test that passing arguments as references work");
56 }
57 threads->create(\&test2, [{'foo' => 'bar'}])->join();
58
59 sub test3 {
60     ok(5, shift() == 1, "Test a normal sub");
61 }
62 threads->create(\&test3, 1)->join();
63
64
65 sub test4 {
66     ok(6, 1, "Detach test");
67 }
68 {
69     my $thread1 = threads->create('test4');
70     $thread1->detach();
71     while ($thread1->is_running()) {
72         threads->yield();
73         sleep 1;
74     }
75 }
76 ok(7, 1, "Detach test");
77
78
79 sub test5 {
80     threads->create('test6')->join();
81     ok(9, 1, "Nested thread test");
82 }
83
84 sub test6 {
85     ok(8, 1, "Nested thread test");
86 }
87
88 threads->create('test5')->join();
89
90
91 sub test7 {
92     my $self = threads->self();
93     ok(10, $self->tid == 7, "Wanted 7, got ".$self->tid);
94     ok(11, threads->tid() == 7, "Wanted 7, got ".threads->tid());
95 }
96 threads->create('test7')->join;
97
98 sub test8 {
99     my $self = threads->self();
100     ok(12, $self->tid == 8, "Wanted 8, got ".$self->tid);
101     ok(13, threads->tid() == 8, "Wanted 8, got ".threads->tid());
102 }
103 threads->create('test8')->join;
104
105
106 ok(14, 0 == threads->self->tid(), "Check so that tid for threads work for main thread");
107 ok(15, 0 == threads->tid(), "Check so that tid for threads work for main thread");
108
109 {
110     no warnings;
111     local *CLONE = sub {
112         ok(16, threads->tid() == 9, "Tid should be correct in the clone");
113     };
114     threads->create(sub {
115         ok(17, threads->tid() == 9, "And tid be 9 here too");
116     })->join();
117 }
118
119 {
120     sub Foo::DESTROY {
121         ok(19, threads->tid() == 10, "In destroy it should be correct too" )
122     }
123     my $foo;
124     threads->create(sub {
125         ok(18, threads->tid() == 10, "And tid be 10 here");
126         $foo = bless {}, 'Foo';
127         return undef;
128     })->join();
129 }
130
131
132 my $thr1 = threads->create(sub {});
133 my $thr2 = threads->create(sub {});
134 my $thr3 = threads->object($thr1->tid());
135
136 # Make sure both overloaded '==' and '!=' are working correctly
137 ok(20,   $thr1 != $thr2,  'Treads not equal');
138 ok(21, !($thr1 == $thr2), 'Treads not equal');
139 ok(22,   $thr1 == $thr3,  'Threads equal');
140 ok(23, !($thr1 != $thr3), 'Threads equal');
141
142 ok(24, $thr1->_handle(), 'Handle method');
143 ok(25, $thr2->_handle(), 'Handle method');
144
145 ok(26, threads->object($thr1->tid())->tid() == 11, 'Object method');
146 ok(27, threads->object($thr2->tid())->tid() == 12, 'Object method');
147
148 $thr1->join();
149 $thr2->join();
150
151 my $sub = sub { ok(28, shift() == 1, "Test code ref"); };
152 threads->create($sub, 1)->join();
153
154 my $thrx = threads->object(99);
155 ok(29, ! defined($thrx), 'No object');
156 $thrx = threads->object();
157 ok(30, ! defined($thrx), 'No object');
158 $thrx = threads->object(undef);
159 ok(31, ! defined($thrx), 'No object');
160 $thrx = threads->object(0);
161 ok(32, ! defined($thrx), 'No object');
162
163 import threads 'stringify';
164 $thr1 = threads->create(sub {});
165 ok(33, "$thr1" eq $thr1->tid(), 'Stringify');
166 $thr1->join();
167
168 # EOF