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