Commit | Line | Data |
---|---|---|
4dcb9e53 JH |
1 | use strict; |
2 | use warnings; | |
3 | ||
4 | BEGIN { | |
2adbc9b6 | 5 | require($ENV{PERL_CORE} ? '../../t/test.pl' : './t/test.pl'); |
7ef93cb2 | 6 | |
4dcb9e53 JH |
7 | use Config; |
8 | if (! $Config{'useithreads'}) { | |
7ef93cb2 | 9 | skip_all(q/Perl not compiled with 'useithreads'/); |
4dcb9e53 JH |
10 | } |
11 | } | |
7ef93cb2 | 12 | |
4629c4f6 | 13 | our $TODO; |
4dcb9e53 JH |
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 JH |
22 | } |
23 | ||
24 | $| = 1; | |
69a9b4b8 | 25 | print("1..18\n"); ### Number of tests that will be run ### |
4dcb9e53 JH |
26 | }; |
27 | ||
4dcb9e53 JH |
28 | ok(1, 'Loaded'); |
29 | ||
4dcb9e53 JH |
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 RGS |
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 | |
c6288a43 | 51 | run_perl(prog => 'use threads 1.83;' . |
60bd5ef6 RGS |
52 | 'threads->exit(86);' . |
53 | 'exit(99);', | |
69a9b4b8 RGS |
54 | nolib => ($ENV{PERL_CORE}) ? 0 : 1, |
55 | switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]); | |
4629c4f6 CB |
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 RGS |
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 RGS |
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 RGS |
80 | my $WAIT :shared = 1; |
81 | $thr = threads->create(sub { | |
82 | lock($WAIT); | |
83 | while ($WAIT) { | |
84 | cond_wait($WAIT); | |
4dcb9e53 | 85 | } |
69a9b4b8 RGS |
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 RGS |
93 | lock($WAIT); |
94 | $WAIT = 0; | |
95 | cond_broadcast($WAIT); | |
4dcb9e53 | 96 | } |
69a9b4b8 RGS |
97 | $rc = $thr->join(); |
98 | ok(! defined($rc), 'Exited: $thr->set_thread_exit_only'); | |
99 | ||
100 | ||
c6288a43 | 101 | run_perl(prog => 'use threads 1.83 qw(exit thread_only);' . |
60bd5ef6 RGS |
102 | 'threads->create(sub { exit(99); })->join();' . |
103 | 'exit(86);', | |
69a9b4b8 RGS |
104 | nolib => ($ENV{PERL_CORE}) ? 0 : 1, |
105 | switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]); | |
4629c4f6 CB |
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 | |
c6288a43 | 111 | my $out = run_perl(prog => 'use threads 1.83;' . |
60bd5ef6 RGS |
112 | 'threads->create(sub {' . |
113 | ' exit(99);' . | |
8718f9a1 JH |
114 | '});' . |
115 | 'sleep(1);' . | |
60bd5ef6 RGS |
116 | 'exit(86);', |
117 | nolib => ($ENV{PERL_CORE}) ? 0 : 1, | |
118 | switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ], | |
119 | stderr => 1); | |
4629c4f6 CB |
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 RGS |
124 | like($out, '1 finished and unjoined', "exit(status) in thread"); |
125 | ||
126 | ||
c6288a43 | 127 | $out = run_perl(prog => 'use threads 1.83 qw(exit thread_only);' . |
60bd5ef6 RGS |
128 | 'threads->create(sub {' . |
129 | ' threads->set_thread_exit_only(0);' . | |
130 | ' exit(99);' . | |
8718f9a1 JH |
131 | '});' . |
132 | 'sleep(1);' . | |
60bd5ef6 RGS |
133 | 'exit(86);', |
134 | nolib => ($ENV{PERL_CORE}) ? 0 : 1, | |
135 | switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ], | |
136 | stderr => 1); | |
4629c4f6 CB |
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 RGS |
141 | like($out, '1 finished and unjoined', "set_thread_exit_only(0)"); |
142 | ||
143 | ||
c6288a43 | 144 | run_perl(prog => 'use threads 1.83;' . |
60bd5ef6 RGS |
145 | 'threads->create(sub {' . |
146 | ' $SIG{__WARN__} = sub { exit(99); };' . | |
147 | ' die();' . | |
148 | '})->join();' . | |
149 | 'exit(86);', | |
69a9b4b8 RGS |
150 | nolib => ($ENV{PERL_CORE}) ? 0 : 1, |
151 | switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]); | |
4629c4f6 CB |
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 RGS |
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 JH |
166 | exit(0); |
167 | ||
4dcb9e53 | 168 | # EOF |