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     if (! $Config{'useithreads'}) {
  11         print("1..0 # Skip: Perl not compiled with 'useithreads'\n");
  12         exit(0);
  13     }
  14 }
  15
  16 use ExtUtils::testlib;
  17
  18 sub ok {
  19     my ($id, $ok, $name) = @_;
  20
  21     # You have to do it this way or VMS will get confused.
  22     if ($ok) {
  23         print("ok $id - $name\n");
  24     } else {
  25         print("not ok $id - $name\n");
  26         printf("# Failed test at line %d\n", (caller)[2]);
  27     }
  28
  29     return ($ok);
  30 }
  31
  32 BEGIN {
  33     $| = 1;
  34     print("1..15\n");   ### Number of tests that will be run ###
  35 };
  36
  37 use threads;
  38 ok(1, 1, 'Loaded');
  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