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.66;' .
  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.66 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.66;' .
 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.66 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.66;' .
 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