5 if ($ENV{'PERL_CORE'}){
7 unshift @INC, '../lib';
10 require($ENV{PERL_CORE} ? "./test.pl" : "./t/test.pl");
13 if (! $Config{'useithreads'}) {
14 skip_all(q/Perl not compiled with 'useithreads'/);
20 use ExtUtils::testlib;
26 require threads::shared;
27 import threads::shared;
29 if ($@ || ! $threads::shared::threads_shared) {
30 skip_all('threads::shared not available');
34 print("1..18\n"); ### Number of tests that will be run ###
39 ### Start of Testing ###
41 $SIG{'__WARN__'} = sub {
43 ok(0, "WARN in main: $msg");
45 $SIG{'__DIE__'} = sub {
47 ok(0, "DIE in main: $msg");
51 my $thr = threads->create(sub {
53 return (99); # Not seen
55 ok($thr, 'Created: threads->exit()');
56 my $rc = $thr->join();
57 ok(! defined($rc), 'Exited: threads->exit()');
60 run_perl(prog => 'use threads 1.69;' .
61 'threads->exit(86);' .
63 nolib => ($ENV{PERL_CORE}) ? 0 : 1,
64 switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]);
66 local $TODO = 'VMS exit semantics not like POSIX exit semantics' if $^O eq 'VMS';
67 is($?>>8, 86, 'thread->exit(status) in main');
70 $thr = threads->create({'exit' => 'thread_only'}, sub {
72 return (99); # Not seen
74 ok($thr, 'Created: thread_only');
76 ok(! defined($rc), 'Exited: thread_only');
79 $thr = threads->create(sub {
80 threads->set_thread_exit_only(1);
82 return (99); # Not seen
84 ok($thr, 'Created: threads->set_thread_exit_only');
86 ok(! defined($rc), 'Exited: threads->set_thread_exit_only');
90 $thr = threads->create(sub {
96 return (99); # Not seen
99 ok($thr, 'Created: $thr->set_thread_exit_only');
100 $thr->set_thread_exit_only(1);
104 cond_broadcast($WAIT);
107 ok(! defined($rc), 'Exited: $thr->set_thread_exit_only');
110 run_perl(prog => 'use threads 1.69 qw(exit thread_only);' .
111 'threads->create(sub { exit(99); })->join();' .
113 nolib => ($ENV{PERL_CORE}) ? 0 : 1,
114 switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]);
116 local $TODO = 'VMS exit semantics not like POSIX exit semantics' if $^O eq 'VMS';
117 is($?>>8, 86, "'use threads 'exit' => 'thread_only'");
120 my $out = run_perl(prog => 'use threads 1.69;' .
121 'threads->create(sub {' .
126 nolib => ($ENV{PERL_CORE}) ? 0 : 1,
127 switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ],
130 local $TODO = 'VMS exit semantics not like POSIX exit semantics' if $^O eq 'VMS';
131 is($?>>8, 99, "exit(status) in thread");
133 like($out, '1 finished and unjoined', "exit(status) in thread");
136 $out = run_perl(prog => 'use threads 1.69 qw(exit thread_only);' .
137 'threads->create(sub {' .
138 ' threads->set_thread_exit_only(0);' .
143 nolib => ($ENV{PERL_CORE}) ? 0 : 1,
144 switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ],
147 local $TODO = 'VMS exit semantics not like POSIX exit semantics' if $^O eq 'VMS';
148 is($?>>8, 99, "set_thread_exit_only(0)");
150 like($out, '1 finished and unjoined', "set_thread_exit_only(0)");
153 run_perl(prog => 'use threads 1.69;' .
154 'threads->create(sub {' .
155 ' $SIG{__WARN__} = sub { exit(99); };' .
159 nolib => ($ENV{PERL_CORE}) ? 0 : 1,
160 switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]);
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");
166 $thr = threads->create(sub {
167 $SIG{__WARN__} = sub { threads->exit(); };
168 local $SIG{__DIE__} = 'DEFAULT';
171 ok($thr, 'Created: threads->exit() in thread warn handler');
173 ok(! defined($rc), 'Exited: threads->exit() in thread warn handler');