This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to threads 2.01
[perl5.git] / dist / threads / t / exit.t
CommitLineData
4dcb9e53
JH
1use strict;
2use warnings;
3
4BEGIN {
2adbc9b6 5 require($ENV{PERL_CORE} ? '../../t/test.pl' : './t/test.pl');
7ef93cb2 6
4dcb9e53
JH
7 use Config;
8 if (! $Config{'useithreads'}) {
7ef93cb2 9 skip_all(q/Perl not compiled with 'useithreads'/);
4dcb9e53
JH
10 }
11}
7ef93cb2 12
4629c4f6 13our $TODO;
4dcb9e53
JH
14
15use ExtUtils::testlib;
16
17use threads;
18
19BEGIN {
e301958b 20 if (! eval 'use threads::shared; 1') {
7ef93cb2 21 skip_all('threads::shared not available');
4dcb9e53
JH
22 }
23
24 $| = 1;
69a9b4b8 25 print("1..18\n"); ### Number of tests that will be run ###
4dcb9e53
JH
26};
27
4dcb9e53
JH
28ok(1, 'Loaded');
29
4dcb9e53
JH
30### Start of Testing ###
31
32$SIG{'__WARN__'} = sub {
33 my $msg = shift;
34 ok(0, "WARN in main: $msg");
35};
36$SIG{'__DIE__'} = sub {
37 my $msg = shift;
38 ok(0, "DIE in main: $msg");
39};
40
41
69a9b4b8
RGS
42my $thr = threads->create(sub {
43 threads->exit();
44 return (99); # Not seen
45});
46ok($thr, 'Created: threads->exit()');
47my $rc = $thr->join();
48ok(! defined($rc), 'Exited: threads->exit()');
4dcb9e53 49
4dcb9e53 50
375a183d 51run_perl(prog => 'use threads 2.01;' .
60bd5ef6
RGS
52 'threads->exit(86);' .
53 'exit(99);',
69a9b4b8
RGS
54 nolib => ($ENV{PERL_CORE}) ? 0 : 1,
55 switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]);
4629c4f6
CB
56{
57 local $TODO = 'VMS exit semantics not like POSIX exit semantics' if $^O eq 'VMS';
58 is($?>>8, 86, 'thread->exit(status) in main');
59}
4dcb9e53 60
69a9b4b8
RGS
61$thr = threads->create({'exit' => 'thread_only'}, sub {
62 exit(1);
63 return (99); # Not seen
64 });
65ok($thr, 'Created: thread_only');
66$rc = $thr->join();
67ok(! defined($rc), 'Exited: thread_only');
4dcb9e53 68
4dcb9e53 69
69a9b4b8
RGS
70$thr = threads->create(sub {
71 threads->set_thread_exit_only(1);
72 exit(1);
73 return (99); # Not seen
74});
75ok($thr, 'Created: threads->set_thread_exit_only');
76$rc = $thr->join();
77ok(! defined($rc), 'Exited: threads->set_thread_exit_only');
4dcb9e53 78
4dcb9e53 79
69a9b4b8
RGS
80my $WAIT :shared = 1;
81$thr = threads->create(sub {
82 lock($WAIT);
83 while ($WAIT) {
84 cond_wait($WAIT);
4dcb9e53 85 }
69a9b4b8
RGS
86 exit(1);
87 return (99); # Not seen
88});
89threads->yield();
90ok($thr, 'Created: $thr->set_thread_exit_only');
91$thr->set_thread_exit_only(1);
4dcb9e53 92{
69a9b4b8
RGS
93 lock($WAIT);
94 $WAIT = 0;
95 cond_broadcast($WAIT);
4dcb9e53 96}
69a9b4b8
RGS
97$rc = $thr->join();
98ok(! defined($rc), 'Exited: $thr->set_thread_exit_only');
99
100
375a183d 101run_perl(prog => 'use threads 2.01 qw(exit thread_only);' .
60bd5ef6
RGS
102 'threads->create(sub { exit(99); })->join();' .
103 'exit(86);',
69a9b4b8
RGS
104 nolib => ($ENV{PERL_CORE}) ? 0 : 1,
105 switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]);
4629c4f6
CB
106{
107 local $TODO = 'VMS exit semantics not like POSIX exit semantics' if $^O eq 'VMS';
108 is($?>>8, 86, "'use threads 'exit' => 'thread_only'");
109}
69a9b4b8 110
375a183d 111my $out = run_perl(prog => 'use threads 2.01;' .
60bd5ef6
RGS
112 'threads->create(sub {' .
113 ' exit(99);' .
8718f9a1
JH
114 '});' .
115 'sleep(1);' .
60bd5ef6
RGS
116 'exit(86);',
117 nolib => ($ENV{PERL_CORE}) ? 0 : 1,
118 switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ],
119 stderr => 1);
4629c4f6
CB
120{
121 local $TODO = 'VMS exit semantics not like POSIX exit semantics' if $^O eq 'VMS';
122 is($?>>8, 99, "exit(status) in thread");
123}
aaa63dae 124like($out, qr/1 finished and unjoined/, "exit(status) in thread");
60bd5ef6
RGS
125
126
375a183d 127$out = run_perl(prog => 'use threads 2.01 qw(exit thread_only);' .
60bd5ef6
RGS
128 'threads->create(sub {' .
129 ' threads->set_thread_exit_only(0);' .
130 ' exit(99);' .
8718f9a1
JH
131 '});' .
132 'sleep(1);' .
60bd5ef6
RGS
133 'exit(86);',
134 nolib => ($ENV{PERL_CORE}) ? 0 : 1,
135 switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ],
136 stderr => 1);
4629c4f6
CB
137{
138 local $TODO = 'VMS exit semantics not like POSIX exit semantics' if $^O eq 'VMS';
139 is($?>>8, 99, "set_thread_exit_only(0)");
140}
aaa63dae 141like($out, qr/1 finished and unjoined/, "set_thread_exit_only(0)");
60bd5ef6
RGS
142
143
375a183d 144run_perl(prog => 'use threads 2.01;' .
60bd5ef6
RGS
145 'threads->create(sub {' .
146 ' $SIG{__WARN__} = sub { exit(99); };' .
147 ' die();' .
148 '})->join();' .
149 'exit(86);',
69a9b4b8
RGS
150 nolib => ($ENV{PERL_CORE}) ? 0 : 1,
151 switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]);
4629c4f6
CB
152{
153 local $TODO = 'VMS exit semantics not like POSIX exit semantics' if $^O eq 'VMS';
154 is($?>>8, 99, "exit(status) in thread warn handler");
155}
69a9b4b8
RGS
156
157$thr = threads->create(sub {
158 $SIG{__WARN__} = sub { threads->exit(); };
159 local $SIG{__DIE__} = 'DEFAULT';
160 die('Died');
161});
162ok($thr, 'Created: threads->exit() in thread warn handler');
163$rc = $thr->join();
164ok(! defined($rc), 'Exited: threads->exit() in thread warn handler');
4dcb9e53 165
561ee912
JH
166exit(0);
167
4dcb9e53 168# EOF