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