ext/threads/t/list.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     unless ($Config{'useithreads'}) {
  11         print "1..0 # Skip: no useithreads\n";
  12         exit 0;
  13     }
  14 }
  15
  16 use ExtUtils::testlib;
  17
  18
  19
  20 BEGIN { $| = 1; print "1..15\n" };
  21 use threads;
  22
  23
  24
  25 print "ok 1\n";
  26
  27
  28 #########################
  29 sub ok {
  30     my ($id, $ok, $name) = @_;
  31
  32     # You have to do it this way or VMS will get confused.
  33     print $ok ? "ok $id - $name\n" : "not ok $id - $name\n";
  34
  35     printf "# Failed test at line %d\n", (caller)[2] unless $ok;
  36
  37     return $ok;
  38 }
  39
  40 ### Start of Testing ###
  41
  42 ok(2, scalar @{[threads->list()]} == 0, 'No threads yet');
  43
  44 threads->create(sub {})->join();
  45 ok(3, scalar @{[threads->list()]} == 0, 'Empty thread list after join');
  46
  47 my $thread = threads->create(sub {});
  48 ok(4, scalar(threads->list()) == 1, 'Non-empty thread list');
  49 ok(5, threads->list() == 1,             'Non-empty thread list');
  50 $thread->join();
  51 ok(6, scalar @{[threads->list()]} == 0, 'Thread list empty again');
  52 ok(7, threads->list() == 0,             'Thread list empty again');
  53
  54 $thread = threads->create(sub {
  55     ok(8, threads->list() == 1, 'Non-empty thread list in thread');
  56     ok(9, threads->self == (threads->list())[0], 'Self in thread list')
  57 });
  58
  59 threads->yield; # help out non-preemptive thread implementations
  60 sleep 1;
  61
  62 ok(10, scalar(threads->list()) == 1, 'Thread count 1');
  63 ok(11, threads->list() == 1,             'Thread count 1');
  64 my $cnt = threads->list();
  65 ok(12, $cnt == 1,                        'Thread count 1');
  66 my ($thr_x) = threads->list();
  67 ok(13, $thread == $thr_x,                'Thread in list');
  68 $thread->join();
  69 ok(14, scalar @{[threads->list()]} == 0, 'Thread list empty');
  70 ok(15, threads->list() == 0,             'Thread list empty');
  71
  72 # EOF