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