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