5 if ($ENV{'PERL_CORE'}){
7 unshift @INC, '../lib';
10 if (! $Config{'useithreads'}) {
11 print("1..0 # Skip: Perl not compiled with 'useithreads'\n");
16 use ExtUtils::testlib;
22 require threads::shared;
23 import threads::shared;
25 if ($@ || ! $threads::shared::threads_shared) {
26 print("1..0 # Skip: threads::shared not available\n");
31 print("1..226\n"); ### Number of tests that will be run ###
44 if (! defined($name)) {
54 # You have to do it this way or VMS will get confused.
56 print("ok $id - $name\n");
58 print("not ok $id - $name\n");
59 printf("# Failed test at line %d\n", (caller)[2]);
60 print(STDERR "# FAIL: $name\n") if (! exists($ENV{'PERL_CORE'}));
67 ### Start of Testing ###
69 $SIG{'__WARN__'} = sub {
71 ok(0, "WARN in main: $msg");
73 $SIG{'__DIE__'} = sub {
75 ok(0, "DIE in main: $msg");
81 my ($term, $warn, $die) = @_;
82 my $tid = threads->tid();
84 $SIG{'__WARN__'} = sub {
86 ok($msg =~ /Thread \d+ terminated abnormally/, "WARN: $msg");
87 if ($warn eq 'return') {
88 return ('# __WARN__ returned');
89 } elsif ($warn eq 'die') {
90 die('# __WARN__ dying');
91 } elsif ($warn eq 'exit') {
98 $SIG{'__DIE__'} = sub {
101 if ($die eq 'return') {
102 return ('# __DIE__ returned');
103 } elsif ($die eq 'die') {
104 die('# __DIE__ dying');
105 } elsif ($die eq 'exit') {
112 ok(1, "Thread $tid");
113 if ($term eq 'return') {
114 return ('# Thread returned');
115 } elsif ($term eq 'die') {
116 die('# Thread dying');
117 } elsif ($term eq 'exit') {
125 my @exit_types = qw(return die exit threads->exit);
127 # Test (non-trivial) combinations of termination methods
128 # WRT the thread and its handlers
129 foreach my $die (@exit_types) {
130 foreach my $wrn (@exit_types) {
131 foreach my $thr (@exit_types) {
132 # Things are well behaved if the thread just returns
133 next if ($thr eq 'return');
135 # Skip combos with the die handler
136 # if neither the thread nor the warn handler dies
137 next if ($thr ne 'die' && $wrn ne 'die' && $die ne 'return');
139 # Must send STDERR to file to filter out 'un-capturable' output
143 if (! open(STDERR, '>tmp.stderr')) {
144 die('Failed to create "tmp.stderr"');
147 $rc = threads->create('nasty', $thr, $wrn, $die)->join();
152 # Filter out 'un-capturable' output
153 if (open(IN, 'tmp.stderr')) {
154 while (my $line = <IN>) {
161 ok(0, "Failed to open 'tmp.stderr': $!");
163 unlink('tmp.stderr');
165 ok(! $@, ($@) ? "Thread problem: $@" : "Thread ran okay");
166 ok(! defined($rc), "Thread returned 'undef'");
173 no warnings 'threads';
177 my ($term, $warn, $die) = @_;
178 my $tid = threads->tid();
180 $SIG{'__WARN__'} = sub {
183 if ($warn eq 'return') {
184 return ('# __WARN__ returned');
185 } elsif ($warn eq 'die') {
186 die('# __WARN__ dying');
187 } elsif ($warn eq 'exit') {
194 $SIG{'__DIE__'} = sub {
197 if ($die eq 'return') {
198 return ('# __DIE__ returned');
199 } elsif ($die eq 'die') {
200 die('# __DIE__ dying');
201 } elsif ($die eq 'exit') {
208 ok(1, "Thread $tid");
209 if ($term eq 'return') {
210 return ('# Thread returned');
211 } elsif ($term eq 'die') {
212 die('# Thread dying');
213 } elsif ($term eq 'exit') {
220 foreach my $die (@exit_types) {
221 foreach my $wrn (@exit_types) {
222 foreach my $thr (@exit_types) {
223 # Things are well behaved if the thread just returns
224 next if ($thr eq 'return');
226 # Skip combos with the die handler
227 # if neither the thread nor the warn handler dies
228 next if ($thr ne 'die' && $wrn ne 'die' && $die ne 'return');
231 eval { $rc = threads->create('less_nasty', $thr, $wrn, $die)->join() };
232 ok(! $@, ($@) ? "Thread problem: $@" : "Thread ran okay");
233 ok(! defined($rc), "Thread returned 'undef'");
239 # Check termination warning concerning running threads
240 $SIG{'__WARN__'} = sub {
242 ok($msg =~ /1 running and unjoined/, '1 running and unjoined');
243 ok($msg =~ /2 finished and unjoined/, '2 finished and unjoined');
244 ok($msg =~ /3 running and detached/, '3 finished and detached');
247 threads->create(sub { sleep(100); });
248 threads->create(sub {});
249 threads->create(sub {});
250 threads->create(sub { sleep(100); })->detach();
251 threads->create(sub { sleep(100); })->detach();
252 threads->create(sub { sleep(100); })->detach();