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