threads 1.67
[perl.git] / ext / threads / t / exit.t
1 use strict;
2 use warnings;
3
4 BEGIN {
5     if ($ENV{'PERL_CORE'}){
6         chdir 't';
7         unshift @INC, '../lib';
8     }
9     use Config;
10     if (! $Config{'useithreads'}) {
11         print("1..0 # Skip: Perl not compiled with 'useithreads'\n");
12         exit(0);
13     }
14
15     require($ENV{PERL_CORE} ? "./test.pl" : "./t/test.pl");
16 }
17 our $TODO;
18
19 use ExtUtils::testlib;
20
21 use threads;
22
23 BEGIN {
24     eval {
25         require threads::shared;
26         import threads::shared;
27     };
28     if ($@ || ! $threads::shared::threads_shared) {
29         print("1..0 # Skip: threads::shared not available\n");
30         exit(0);
31     }
32
33     $| = 1;
34     print("1..18\n");   ### Number of tests that will be run ###
35 };
36
37 ok(1, 'Loaded');
38
39 ### Start of Testing ###
40
41 $SIG{'__WARN__'} = sub {
42     my $msg = shift;
43     ok(0, "WARN in main: $msg");
44 };
45 $SIG{'__DIE__'} = sub {
46     my $msg = shift;
47     ok(0, "DIE in main: $msg");
48 };
49
50
51 my $thr = threads->create(sub {
52     threads->exit();
53     return (99);  # Not seen
54 });
55 ok($thr, 'Created: threads->exit()');
56 my $rc = $thr->join();
57 ok(! defined($rc), 'Exited: threads->exit()');
58
59
60 run_perl(prog => 'use threads 1.67;' .
61                  'threads->exit(86);' .
62                  'exit(99);',
63          nolib => ($ENV{PERL_CORE}) ? 0 : 1,
64          switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]);
65 {
66     local $TODO = 'VMS exit semantics not like POSIX exit semantics' if $^O eq 'VMS';
67     is($?>>8, 86, 'thread->exit(status) in main');
68 }
69
70 $thr = threads->create({'exit' => 'thread_only'}, sub {
71                                                     exit(1);
72                                                     return (99);  # Not seen
73                                                   });
74 ok($thr, 'Created: thread_only');
75 $rc = $thr->join();
76 ok(! defined($rc), 'Exited: thread_only');
77
78
79 $thr = threads->create(sub {
80     threads->set_thread_exit_only(1);
81     exit(1);
82     return (99);  # Not seen
83 });
84 ok($thr, 'Created: threads->set_thread_exit_only');
85 $rc = $thr->join();
86 ok(! defined($rc), 'Exited: threads->set_thread_exit_only');
87
88
89 my $WAIT :shared = 1;
90 $thr = threads->create(sub {
91     lock($WAIT);
92     while ($WAIT) {
93         cond_wait($WAIT);
94     }
95     exit(1);
96     return (99);  # Not seen
97 });
98 threads->yield();
99 ok($thr, 'Created: $thr->set_thread_exit_only');
100 $thr->set_thread_exit_only(1);
101 {
102     lock($WAIT);
103     $WAIT = 0;
104     cond_broadcast($WAIT);
105 }
106 $rc = $thr->join();
107 ok(! defined($rc), 'Exited: $thr->set_thread_exit_only');
108
109
110 run_perl(prog => 'use threads 1.67 qw(exit thread_only);' .
111                  'threads->create(sub { exit(99); })->join();' .
112                  'exit(86);',
113          nolib => ($ENV{PERL_CORE}) ? 0 : 1,
114          switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]);
115 {
116     local $TODO = 'VMS exit semantics not like POSIX exit semantics' if $^O eq 'VMS';
117     is($?>>8, 86, "'use threads 'exit' => 'thread_only'");
118 }
119
120 my $out = run_perl(prog => 'use threads 1.67;' .
121                            'threads->create(sub {' .
122                            '    exit(99);' .
123                            '});' .
124                            'sleep(1);' .
125                            'exit(86);',
126                    nolib => ($ENV{PERL_CORE}) ? 0 : 1,
127                    switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ],
128                    stderr => 1);
129 {
130     local $TODO = 'VMS exit semantics not like POSIX exit semantics' if $^O eq 'VMS';
131     is($?>>8, 99, "exit(status) in thread");
132 }
133 like($out, '1 finished and unjoined', "exit(status) in thread");
134
135
136 $out = run_perl(prog => 'use threads 1.67 qw(exit thread_only);' .
137                         'threads->create(sub {' .
138                         '   threads->set_thread_exit_only(0);' .
139                         '   exit(99);' .
140                         '});' .
141                         'sleep(1);' .
142                         'exit(86);',
143                 nolib => ($ENV{PERL_CORE}) ? 0 : 1,
144                 switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ],
145                 stderr => 1);
146 {
147     local $TODO = 'VMS exit semantics not like POSIX exit semantics' if $^O eq 'VMS';
148     is($?>>8, 99, "set_thread_exit_only(0)");
149 }
150 like($out, '1 finished and unjoined', "set_thread_exit_only(0)");
151
152
153 run_perl(prog => 'use threads 1.67;' .
154                  'threads->create(sub {' .
155                  '   $SIG{__WARN__} = sub { exit(99); };' .
156                  '   die();' .
157                  '})->join();' .
158                  'exit(86);',
159          nolib => ($ENV{PERL_CORE}) ? 0 : 1,
160          switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]);
161 {
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");
164 }
165
166 $thr = threads->create(sub {
167     $SIG{__WARN__} = sub { threads->exit(); };
168     local $SIG{__DIE__} = 'DEFAULT';
169     die('Died');
170 });
171 ok($thr, 'Created: threads->exit() in thread warn handler');
172 $rc = $thr->join();
173 ok(! defined($rc), 'Exited: threads->exit() in thread warn handler');
174
175 # EOF