This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
25fba99c94a19e6b6faf42bd8665ba3e69b2a376
[perl5.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
18 use ExtUtils::testlib;
19
20 use threads;
21
22 BEGIN {
23     eval {
24         require threads::shared;
25         import threads::shared;
26     };
27     if ($@ || ! $threads::shared::threads_shared) {
28         print("1..0 # Skip: threads::shared not available\n");
29         exit(0);
30     }
31
32     $| = 1;
33     print("1..18\n");   ### Number of tests that will be run ###
34 };
35
36 ok(1, 'Loaded');
37
38 ### Start of Testing ###
39
40 $SIG{'__WARN__'} = sub {
41     my $msg = shift;
42     ok(0, "WARN in main: $msg");
43 };
44 $SIG{'__DIE__'} = sub {
45     my $msg = shift;
46     ok(0, "DIE in main: $msg");
47 };
48
49
50 my $thr = threads->create(sub {
51     threads->exit();
52     return (99);  # Not seen
53 });
54 ok($thr, 'Created: threads->exit()');
55 my $rc = $thr->join();
56 ok(! defined($rc), 'Exited: threads->exit()');
57
58
59 run_perl(prog => 'use threads 1.54;' .
60                  'threads->exit(86);' .
61                  'exit(99);',
62          nolib => ($ENV{PERL_CORE}) ? 0 : 1,
63          switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]);
64 is($?>>8, 86, 'thread->exit(status) in main');
65
66
67 $thr = threads->create({'exit' => 'thread_only'}, sub {
68                                                     exit(1);
69                                                     return (99);  # Not seen
70                                                   });
71 ok($thr, 'Created: thread_only');
72 $rc = $thr->join();
73 ok(! defined($rc), 'Exited: thread_only');
74
75
76 $thr = threads->create(sub {
77     threads->set_thread_exit_only(1);
78     exit(1);
79     return (99);  # Not seen
80 });
81 ok($thr, 'Created: threads->set_thread_exit_only');
82 $rc = $thr->join();
83 ok(! defined($rc), 'Exited: threads->set_thread_exit_only');
84
85
86 my $WAIT :shared = 1;
87 $thr = threads->create(sub {
88     lock($WAIT);
89     while ($WAIT) {
90         cond_wait($WAIT);
91     }
92     exit(1);
93     return (99);  # Not seen
94 });
95 threads->yield();
96 ok($thr, 'Created: $thr->set_thread_exit_only');
97 $thr->set_thread_exit_only(1);
98 {
99     lock($WAIT);
100     $WAIT = 0;
101     cond_broadcast($WAIT);
102 }
103 $rc = $thr->join();
104 ok(! defined($rc), 'Exited: $thr->set_thread_exit_only');
105
106
107 run_perl(prog => 'use threads 1.54 qw(exit thread_only);' .
108                  'threads->create(sub { exit(99); })->join();' .
109                  'exit(86);',
110          nolib => ($ENV{PERL_CORE}) ? 0 : 1,
111          switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]);
112 is($?>>8, 86, "'use threads 'exit' => 'thread_only'");
113
114
115 my $out = run_perl(prog => 'use threads 1.54;' .
116                            'threads->create(sub {' .
117                            '    exit(99);' .
118                            '})->join();' .
119                            'exit(86);',
120                    nolib => ($ENV{PERL_CORE}) ? 0 : 1,
121                    switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ],
122                    stderr => 1);
123 is($?>>8, 99, "exit(status) in thread");
124 like($out, '1 finished and unjoined', "exit(status) in thread");
125
126
127 $out = run_perl(prog => 'use threads 1.54 qw(exit thread_only);' .
128                         'threads->create(sub {' .
129                         '   threads->set_thread_exit_only(0);' .
130                         '   exit(99);' .
131                         '})->join();' .
132                         'exit(86);',
133                 nolib => ($ENV{PERL_CORE}) ? 0 : 1,
134                 switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ],
135                 stderr => 1);
136 is($?>>8, 99, "set_thread_exit_only(0)");
137 like($out, '1 finished and unjoined', "set_thread_exit_only(0)");
138
139
140 run_perl(prog => 'use threads 1.54;' .
141                  'threads->create(sub {' .
142                  '   $SIG{__WARN__} = sub { exit(99); };' .
143                  '   die();' .
144                  '})->join();' .
145                  'exit(86);',
146          nolib => ($ENV{PERL_CORE}) ? 0 : 1,
147          switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]);
148 is($?>>8, 99, "exit(status) in thread warn handler");
149
150
151 $thr = threads->create(sub {
152     $SIG{__WARN__} = sub { threads->exit(); };
153     local $SIG{__DIE__} = 'DEFAULT';
154     die('Died');
155 });
156 ok($thr, 'Created: threads->exit() in thread warn handler');
157 $rc = $thr->join();
158 ok(! defined($rc), 'Exited: threads->exit() in thread warn handler');
159
160 # EOF