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 { |
25 | eval { |
26 | require threads::shared; |
27 | import threads::shared; |
28 | }; |
29 | if ($@ || ! $threads::shared::threads_shared) { |
7ef93cb2 |
30 | skip_all('threads::shared not available'); |
4dcb9e53 |
31 | } |
32 | |
33 | $| = 1; |
69a9b4b8 |
34 | print("1..18\n"); ### Number of tests that will be run ### |
4dcb9e53 |
35 | }; |
36 | |
4dcb9e53 |
37 | ok(1, 'Loaded'); |
38 | |
4dcb9e53 |
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 |
51 | my $thr = threads->create(sub { |
52 | threads->exit(); |
53 | return (99); # Not seen |
54 | }); |
55 | ok($thr, 'Created: threads->exit()'); |
56 | my $rc = $thr->join(); |
57 | ok(! defined($rc), 'Exited: threads->exit()'); |
4dcb9e53 |
58 | |
4dcb9e53 |
59 | |
561ee912 |
60 | run_perl(prog => 'use threads 1.71;' . |
60bd5ef6 |
61 | 'threads->exit(86);' . |
62 | 'exit(99);', |
69a9b4b8 |
63 | nolib => ($ENV{PERL_CORE}) ? 0 : 1, |
64 | switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]); |
4629c4f6 |
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 |
70 | $thr = threads->create({'exit' => 'thread_only'}, sub { |
71 | exit(1); |
72 | return (99); # Not seen |
73 | }); |
74 | ok($thr, 'Created: thread_only'); |
75 | $rc = $thr->join(); |
76 | ok(! defined($rc), 'Exited: thread_only'); |
4dcb9e53 |
77 | |
4dcb9e53 |
78 | |
69a9b4b8 |
79 | $thr = threads->create(sub { |
80 | threads->set_thread_exit_only(1); |
81 | exit(1); |
82 | return (99); # Not seen |
83 | }); |
84 | ok($thr, 'Created: threads->set_thread_exit_only'); |
85 | $rc = $thr->join(); |
86 | ok(! defined($rc), 'Exited: threads->set_thread_exit_only'); |
4dcb9e53 |
87 | |
4dcb9e53 |
88 | |
69a9b4b8 |
89 | my $WAIT :shared = 1; |
90 | $thr = threads->create(sub { |
91 | lock($WAIT); |
92 | while ($WAIT) { |
93 | cond_wait($WAIT); |
4dcb9e53 |
94 | } |
69a9b4b8 |
95 | exit(1); |
96 | return (99); # Not seen |
97 | }); |
98 | threads->yield(); |
99 | ok($thr, 'Created: $thr->set_thread_exit_only'); |
100 | $thr->set_thread_exit_only(1); |
4dcb9e53 |
101 | { |
69a9b4b8 |
102 | lock($WAIT); |
103 | $WAIT = 0; |
104 | cond_broadcast($WAIT); |
4dcb9e53 |
105 | } |
69a9b4b8 |
106 | $rc = $thr->join(); |
107 | ok(! defined($rc), 'Exited: $thr->set_thread_exit_only'); |
108 | |
109 | |
561ee912 |
110 | run_perl(prog => 'use threads 1.71 qw(exit thread_only);' . |
60bd5ef6 |
111 | 'threads->create(sub { exit(99); })->join();' . |
112 | 'exit(86);', |
69a9b4b8 |
113 | nolib => ($ENV{PERL_CORE}) ? 0 : 1, |
114 | switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]); |
4629c4f6 |
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 | |
561ee912 |
120 | my $out = run_perl(prog => 'use threads 1.71;' . |
60bd5ef6 |
121 | 'threads->create(sub {' . |
122 | ' exit(99);' . |
8718f9a1 |
123 | '});' . |
124 | 'sleep(1);' . |
60bd5ef6 |
125 | 'exit(86);', |
126 | nolib => ($ENV{PERL_CORE}) ? 0 : 1, |
127 | switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ], |
128 | stderr => 1); |
4629c4f6 |
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 |
133 | like($out, '1 finished and unjoined', "exit(status) in thread"); |
134 | |
135 | |
561ee912 |
136 | $out = run_perl(prog => 'use threads 1.71 qw(exit thread_only);' . |
60bd5ef6 |
137 | 'threads->create(sub {' . |
138 | ' threads->set_thread_exit_only(0);' . |
139 | ' exit(99);' . |
8718f9a1 |
140 | '});' . |
141 | 'sleep(1);' . |
60bd5ef6 |
142 | 'exit(86);', |
143 | nolib => ($ENV{PERL_CORE}) ? 0 : 1, |
144 | switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ], |
145 | stderr => 1); |
4629c4f6 |
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 |
150 | like($out, '1 finished and unjoined', "set_thread_exit_only(0)"); |
151 | |
152 | |
561ee912 |
153 | run_perl(prog => 'use threads 1.71;' . |
60bd5ef6 |
154 | 'threads->create(sub {' . |
155 | ' $SIG{__WARN__} = sub { exit(99); };' . |
156 | ' die();' . |
157 | '})->join();' . |
158 | 'exit(86);', |
69a9b4b8 |
159 | nolib => ($ENV{PERL_CORE}) ? 0 : 1, |
160 | switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]); |
4629c4f6 |
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 |
165 | |
166 | $thr = threads->create(sub { |
167 | $SIG{__WARN__} = sub { threads->exit(); }; |
168 | local $SIG{__DIE__} = 'DEFAULT'; |
169 | die('Died'); |
170 | }); |
171 | ok($thr, 'Created: threads->exit() in thread warn handler'); |
172 | $rc = $thr->join(); |
173 | ok(! defined($rc), 'Exited: threads->exit() in thread warn handler'); |
4dcb9e53 |
174 | |
561ee912 |
175 | exit(0); |
176 | |
4dcb9e53 |
177 | # EOF |