Commit | Line | Data |
4dcb9e53 |
1 | use strict; |
2 | use warnings; |
3 | |
4 | BEGIN { |
2adbc9b6 |
5 | require($ENV{PERL_CORE} ? '../../t/test.pl' : './t/test.pl'); |
7ef93cb2 |
6 | |
4dcb9e53 |
7 | use Config; |
8 | if (! $Config{'useithreads'}) { |
7ef93cb2 |
9 | skip_all(q/Perl not compiled with 'useithreads'/); |
4dcb9e53 |
10 | } |
11 | } |
7ef93cb2 |
12 | |
4629c4f6 |
13 | our $TODO; |
4dcb9e53 |
14 | |
15 | use ExtUtils::testlib; |
16 | |
17 | use threads; |
18 | |
19 | BEGIN { |
e301958b |
20 | if (! eval 'use threads::shared; 1') { |
7ef93cb2 |
21 | skip_all('threads::shared not available'); |
4dcb9e53 |
22 | } |
23 | |
24 | $| = 1; |
69a9b4b8 |
25 | print("1..18\n"); ### Number of tests that will be run ### |
4dcb9e53 |
26 | }; |
27 | |
4dcb9e53 |
28 | ok(1, 'Loaded'); |
29 | |
4dcb9e53 |
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 |
42 | my $thr = threads->create(sub { |
43 | threads->exit(); |
44 | return (99); # Not seen |
45 | }); |
46 | ok($thr, 'Created: threads->exit()'); |
47 | my $rc = $thr->join(); |
48 | ok(! defined($rc), 'Exited: threads->exit()'); |
4dcb9e53 |
49 | |
4dcb9e53 |
50 | |
b91a79b9 |
51 | run_perl(prog => 'use threads 1.77;' . |
60bd5ef6 |
52 | 'threads->exit(86);' . |
53 | 'exit(99);', |
69a9b4b8 |
54 | nolib => ($ENV{PERL_CORE}) ? 0 : 1, |
55 | switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]); |
4629c4f6 |
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 |
61 | $thr = threads->create({'exit' => 'thread_only'}, sub { |
62 | exit(1); |
63 | return (99); # Not seen |
64 | }); |
65 | ok($thr, 'Created: thread_only'); |
66 | $rc = $thr->join(); |
67 | ok(! defined($rc), 'Exited: thread_only'); |
4dcb9e53 |
68 | |
4dcb9e53 |
69 | |
69a9b4b8 |
70 | $thr = threads->create(sub { |
71 | threads->set_thread_exit_only(1); |
72 | exit(1); |
73 | return (99); # Not seen |
74 | }); |
75 | ok($thr, 'Created: threads->set_thread_exit_only'); |
76 | $rc = $thr->join(); |
77 | ok(! defined($rc), 'Exited: threads->set_thread_exit_only'); |
4dcb9e53 |
78 | |
4dcb9e53 |
79 | |
69a9b4b8 |
80 | my $WAIT :shared = 1; |
81 | $thr = threads->create(sub { |
82 | lock($WAIT); |
83 | while ($WAIT) { |
84 | cond_wait($WAIT); |
4dcb9e53 |
85 | } |
69a9b4b8 |
86 | exit(1); |
87 | return (99); # Not seen |
88 | }); |
89 | threads->yield(); |
90 | ok($thr, 'Created: $thr->set_thread_exit_only'); |
91 | $thr->set_thread_exit_only(1); |
4dcb9e53 |
92 | { |
69a9b4b8 |
93 | lock($WAIT); |
94 | $WAIT = 0; |
95 | cond_broadcast($WAIT); |
4dcb9e53 |
96 | } |
69a9b4b8 |
97 | $rc = $thr->join(); |
98 | ok(! defined($rc), 'Exited: $thr->set_thread_exit_only'); |
99 | |
100 | |
b91a79b9 |
101 | run_perl(prog => 'use threads 1.77 qw(exit thread_only);' . |
60bd5ef6 |
102 | 'threads->create(sub { exit(99); })->join();' . |
103 | 'exit(86);', |
69a9b4b8 |
104 | nolib => ($ENV{PERL_CORE}) ? 0 : 1, |
105 | switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]); |
4629c4f6 |
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 | |
b91a79b9 |
111 | my $out = run_perl(prog => 'use threads 1.77;' . |
60bd5ef6 |
112 | 'threads->create(sub {' . |
113 | ' exit(99);' . |
8718f9a1 |
114 | '});' . |
115 | 'sleep(1);' . |
60bd5ef6 |
116 | 'exit(86);', |
117 | nolib => ($ENV{PERL_CORE}) ? 0 : 1, |
118 | switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ], |
119 | stderr => 1); |
4629c4f6 |
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 | } |
60bd5ef6 |
124 | like($out, '1 finished and unjoined', "exit(status) in thread"); |
125 | |
126 | |
b91a79b9 |
127 | $out = run_perl(prog => 'use threads 1.77 qw(exit thread_only);' . |
60bd5ef6 |
128 | 'threads->create(sub {' . |
129 | ' threads->set_thread_exit_only(0);' . |
130 | ' exit(99);' . |
8718f9a1 |
131 | '});' . |
132 | 'sleep(1);' . |
60bd5ef6 |
133 | 'exit(86);', |
134 | nolib => ($ENV{PERL_CORE}) ? 0 : 1, |
135 | switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ], |
136 | stderr => 1); |
4629c4f6 |
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 | } |
60bd5ef6 |
141 | like($out, '1 finished and unjoined', "set_thread_exit_only(0)"); |
142 | |
143 | |
b91a79b9 |
144 | run_perl(prog => 'use threads 1.77;' . |
60bd5ef6 |
145 | 'threads->create(sub {' . |
146 | ' $SIG{__WARN__} = sub { exit(99); };' . |
147 | ' die();' . |
148 | '})->join();' . |
149 | 'exit(86);', |
69a9b4b8 |
150 | nolib => ($ENV{PERL_CORE}) ? 0 : 1, |
151 | switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]); |
4629c4f6 |
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 |
156 | |
157 | $thr = threads->create(sub { |
158 | $SIG{__WARN__} = sub { threads->exit(); }; |
159 | local $SIG{__DIE__} = 'DEFAULT'; |
160 | die('Died'); |
161 | }); |
162 | ok($thr, 'Created: threads->exit() in thread warn handler'); |
163 | $rc = $thr->join(); |
164 | ok(! defined($rc), 'Exited: threads->exit() in thread warn handler'); |
4dcb9e53 |
165 | |
561ee912 |
166 | exit(0); |
167 | |
4dcb9e53 |
168 | # EOF |