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 my $out = run_perl(prog => 'use threads 1.37;' .
 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.37 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.37;' .
 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