xref: /openbsd/gnu/usr.bin/perl/dist/threads/t/exit.t (revision 8932bfb7) 
1use strict;
2use warnings;
3
4BEGIN {
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
13our $TODO;
14
15use ExtUtils::testlib;
16
17use threads;
18
19BEGIN {
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
28ok(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
42my $thr = threads->create(sub {
43    threads->exit();
44    return (99);  # Not seen
45});
46ok($thr, 'Created: threads->exit()');
47my $rc = $thr->join();
48ok(! defined($rc), 'Exited: threads->exit()');
49
50
51run_perl(prog => 'use threads 1.75;' .
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                                                  });
65ok($thr, 'Created: thread_only');
66$rc = $thr->join();
67ok(! 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});
75ok($thr, 'Created: threads->set_thread_exit_only');
76$rc = $thr->join();
77ok(! defined($rc), 'Exited: threads->set_thread_exit_only');
78
79
80my $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});
89threads->yield();
90ok($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();
98ok(! defined($rc), 'Exited: $thr->set_thread_exit_only');
99
100
101run_perl(prog => 'use threads 1.75 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
111my $out = run_perl(prog => 'use threads 1.75;' .
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}
124like($out, '1 finished and unjoined', "exit(status) in thread");
125
126
127$out = run_perl(prog => 'use threads 1.75 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}
141like($out, '1 finished and unjoined', "set_thread_exit_only(0)");
142
143
144run_perl(prog => 'use threads 1.75;' .
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});
162ok($thr, 'Created: threads->exit() in thread warn handler');
163$rc = $thr->join();
164ok(! defined($rc), 'Exited: threads->exit() in thread warn handler');
165
166exit(0);
167
168# EOF
169