5 require($ENV{PERL_CORE} ? '../../t/test.pl' : './t/test.pl');
8 if (! $Config{'useithreads'}) {
9 skip_all(q/Perl not compiled with 'useithreads'/);
15 use ExtUtils::testlib;
20 if (! eval 'use threads::shared; 1') {
21 skip_all('threads::shared not available');
25 print("1..18\n"); ### Number of tests that will be run ###
30 ### Start of Testing ###
32 $SIG{'__WARN__'} = sub {
34 ok(0, "WARN in main: $msg");
36 $SIG{'__DIE__'} = sub {
38 ok(0, "DIE in main: $msg");
42 my $thr = threads->create(sub {
44 return (99); # Not seen
46 ok($thr, 'Created: threads->exit()');
47 my $rc = $thr->join();
48 ok(! defined($rc), 'Exited: threads->exit()');
51 run_perl(prog => 'use threads 1.77;' .
52 'threads->exit(86);' .
54 nolib => ($ENV{PERL_CORE}) ? 0 : 1,
55 switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]);
57 local $TODO = 'VMS exit semantics not like POSIX exit semantics' if $^O eq 'VMS';
58 is($?>>8, 86, 'thread->exit(status) in main');
61 $thr = threads->create({'exit' => 'thread_only'}, sub {
63 return (99); # Not seen
65 ok($thr, 'Created: thread_only');
67 ok(! defined($rc), 'Exited: thread_only');
70 $thr = threads->create(sub {
71 threads->set_thread_exit_only(1);
73 return (99); # Not seen
75 ok($thr, 'Created: threads->set_thread_exit_only');
77 ok(! defined($rc), 'Exited: threads->set_thread_exit_only');
81 $thr = threads->create(sub {
87 return (99); # Not seen
90 ok($thr, 'Created: $thr->set_thread_exit_only');
91 $thr->set_thread_exit_only(1);
95 cond_broadcast($WAIT);
98 ok(! defined($rc), 'Exited: $thr->set_thread_exit_only');
101 run_perl(prog => 'use threads 1.77 qw(exit thread_only);' .
102 'threads->create(sub { exit(99); })->join();' .
104 nolib => ($ENV{PERL_CORE}) ? 0 : 1,
105 switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]);
107 local $TODO = 'VMS exit semantics not like POSIX exit semantics' if $^O eq 'VMS';
108 is($?>>8, 86, "'use threads 'exit' => 'thread_only'");
111 my $out = run_perl(prog => 'use threads 1.77;' .
112 'threads->create(sub {' .
117 nolib => ($ENV{PERL_CORE}) ? 0 : 1,
118 switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ],
121 local $TODO = 'VMS exit semantics not like POSIX exit semantics' if $^O eq 'VMS';
122 is($?>>8, 99, "exit(status) in thread");
124 like($out, '1 finished and unjoined', "exit(status) in thread");
127 $out = run_perl(prog => 'use threads 1.77 qw(exit thread_only);' .
128 'threads->create(sub {' .
129 ' threads->set_thread_exit_only(0);' .
134 nolib => ($ENV{PERL_CORE}) ? 0 : 1,
135 switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ],
138 local $TODO = 'VMS exit semantics not like POSIX exit semantics' if $^O eq 'VMS';
139 is($?>>8, 99, "set_thread_exit_only(0)");
141 like($out, '1 finished and unjoined', "set_thread_exit_only(0)");
144 run_perl(prog => 'use threads 1.77;' .
145 'threads->create(sub {' .
146 ' $SIG{__WARN__} = sub { exit(99); };' .
150 nolib => ($ENV{PERL_CORE}) ? 0 : 1,
151 switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]);
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");
157 $thr = threads->create(sub {
158 $SIG{__WARN__} = sub { threads->exit(); };
159 local $SIG{__DIE__} = 'DEFAULT';
162 ok($thr, 'Created: threads->exit() in thread warn handler');
164 ok(! defined($rc), 'Exited: threads->exit() in thread warn handler');