5 if ($ENV{'PERL_CORE'}){
7 unshift @INC, '../lib';
10 if (! $Config{'useithreads'}) {
11 print("1..0 # Skip: Perl not compiled with 'useithreads'\n");
15 require($ENV{PERL_CORE} ? "./test.pl" : "./t/test.pl");
18 use ExtUtils::testlib;
24 require threads::shared;
25 import threads::shared;
27 if ($@ || ! $threads::shared::threads_shared) {
28 print("1..0 # Skip: threads::shared not available\n");
33 print("1..18\n"); ### Number of tests that will be run ###
38 ### Start of Testing ###
40 $SIG{'__WARN__'} = sub {
42 ok(0, "WARN in main: $msg");
44 $SIG{'__DIE__'} = sub {
46 ok(0, "DIE in main: $msg");
50 my $thr = threads->create(sub {
52 return (99); # Not seen
54 ok($thr, 'Created: threads->exit()');
55 my $rc = $thr->join();
56 ok(! defined($rc), 'Exited: threads->exit()');
59 run_perl(prog => 'use threads 1.57;' .
60 'threads->exit(86);' .
62 nolib => ($ENV{PERL_CORE}) ? 0 : 1,
63 switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]);
64 is($?>>8, 86, 'thread->exit(status) in main');
67 $thr = threads->create({'exit' => 'thread_only'}, sub {
69 return (99); # Not seen
71 ok($thr, 'Created: thread_only');
73 ok(! defined($rc), 'Exited: thread_only');
76 $thr = threads->create(sub {
77 threads->set_thread_exit_only(1);
79 return (99); # Not seen
81 ok($thr, 'Created: threads->set_thread_exit_only');
83 ok(! defined($rc), 'Exited: threads->set_thread_exit_only');
87 $thr = threads->create(sub {
93 return (99); # Not seen
96 ok($thr, 'Created: $thr->set_thread_exit_only');
97 $thr->set_thread_exit_only(1);
101 cond_broadcast($WAIT);
104 ok(! defined($rc), 'Exited: $thr->set_thread_exit_only');
107 run_perl(prog => 'use threads 1.57 qw(exit thread_only);' .
108 'threads->create(sub { exit(99); })->join();' .
110 nolib => ($ENV{PERL_CORE}) ? 0 : 1,
111 switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]);
112 is($?>>8, 86, "'use threads 'exit' => 'thread_only'");
115 my $out = run_perl(prog => 'use threads 1.57;' .
116 'threads->create(sub {' .
121 nolib => ($ENV{PERL_CORE}) ? 0 : 1,
122 switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ],
124 is($?>>8, 99, "exit(status) in thread");
125 like($out, '1 finished and unjoined', "exit(status) in thread");
128 $out = run_perl(prog => 'use threads 1.57 qw(exit thread_only);' .
129 'threads->create(sub {' .
130 ' threads->set_thread_exit_only(0);' .
135 nolib => ($ENV{PERL_CORE}) ? 0 : 1,
136 switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ],
138 is($?>>8, 99, "set_thread_exit_only(0)");
139 like($out, '1 finished and unjoined', "set_thread_exit_only(0)");
142 run_perl(prog => 'use threads 1.57;' .
143 'threads->create(sub {' .
144 ' $SIG{__WARN__} = sub { exit(99); };' .
148 nolib => ($ENV{PERL_CORE}) ? 0 : 1,
149 switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]);
150 is($?>>8, 99, "exit(status) in thread warn handler");
153 $thr = threads->create(sub {
154 $SIG{__WARN__} = sub { threads->exit(); };
155 local $SIG{__DIE__} = 'DEFAULT';
158 ok($thr, 'Created: threads->exit() in thread warn handler');
160 ok(! defined($rc), 'Exited: threads->exit() in thread warn handler');