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.37;
  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.37 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 SKIP: {
 116     skip('run_perl+STDERR broken under MSWin32', 4) if ($^O eq 'MSWin32');
 117
 118     my $out = run_perl(prog => 'use threads 1.37;
 119                                 threads->create(sub {
 120                                     exit(99);
 121                                 })->join();
 122                                 exit(86);',
 123                        nolib => ($ENV{PERL_CORE}) ? 0 : 1,
 124                        switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ],
 125                        stderr => 1);
 126     is($?>>8, 99, "exit(status) in thread");
 127     like($out, '1 finished and unjoined', "exit(status) in thread");
 128
 129
 130     $out = run_perl(prog => 'use threads 1.37 qw(exit thread_only);
 131                              threads->create(sub {
 132                                 threads->set_thread_exit_only(0);
 133                                 exit(99);
 134                              })->join();
 135                              exit(86);',
 136                     nolib => ($ENV{PERL_CORE}) ? 0 : 1,
 137                     switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ],
 138                     stderr => 1);
 139     is($?>>8, 99, "set_thread_exit_only(0)");
 140     like($out, '1 finished and unjoined', "set_thread_exit_only(0)");
 141 }
 142
 143
 144 run_perl(prog => 'use threads 1.37;
 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 is($?>>8, 99, "exit(status) in thread warn handler");
 153
 154
 155 $thr = threads->create(sub {
 156     $SIG{__WARN__} = sub { threads->exit(); };
 157     local $SIG{__DIE__} = 'DEFAULT';
 158     die('Died');
 159 });
 160 ok($thr, 'Created: threads->exit() in thread warn handler');
 161 $rc = $thr->join();
 162 ok(! defined($rc), 'Exited: threads->exit() in thread warn handler');
 163
 164 # EOF