dist/threads/t/basic.t

   1 use strict;
   2 use warnings;
   3
   4 BEGIN {
   5     use Config;
   6     if (! $Config{'useithreads'}) {
   7         print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
   8         exit(0);
   9     }
  10 }
  11
  12 use ExtUtils::testlib;
  13
  14 sub ok {
  15     my ($id, $ok, $name) = @_;
  16
  17     # You have to do it this way or VMS will get confused.
  18     if ($ok) {
  19         print("ok $id - $name\n");
  20     } else {
  21         print("not ok $id - $name\n");
  22         printf("# Failed test at line %d\n", (caller)[2]);
  23     }
  24
  25     return ($ok);
  26 }
  27
  28 BEGIN {
  29     $| = 1;
  30     print("1..34\n");   ### Number of tests that will be run ###
  31 };
  32
  33 use threads;
  34
  35 if ($threads::VERSION && ! $ENV{'PERL_CORE'}) {
  36     print(STDERR "# Testing threads $threads::VERSION\n");
  37 }
  38
  39 ok(1, 1, 'Loaded');
  40
  41 ### Start of Testing ###
  42
  43 ok(2, 1 == $threads::threads, "Check that threads::threads is true");
  44
  45 sub test1 {
  46     ok(3,'bar' eq $_[0], "Test that argument passing works");
  47 }
  48 threads->create('test1', 'bar')->join();
  49
  50 sub test2 {
  51     ok(4,'bar' eq $_[0]->[0]->{'foo'}, "Test that passing arguments as references work");
  52 }
  53 threads->create(\&test2, [{'foo' => 'bar'}])->join();
  54
  55 sub test3 {
  56     ok(5, shift() == 1, "Test a normal sub");
  57 }
  58 threads->create(\&test3, 1)->join();
  59
  60
  61 sub test4 {
  62     ok(6, 1, "Detach test");
  63 }
  64 {
  65     my $thread1 = threads->create('test4');
  66     $thread1->detach();
  67     while ($thread1->is_running()) {
  68         threads->yield();
  69         sleep 1;
  70     }
  71 }
  72 ok(7, 1, "Detach test");
  73
  74
  75 sub test5 {
  76     threads->create('test6')->join();
  77     ok(9, 1, "Nested thread test");
  78 }
  79
  80 sub test6 {
  81     ok(8, 1, "Nested thread test");
  82 }
  83
  84 threads->create('test5')->join();
  85
  86
  87 sub test7 {
  88     my $self = threads->self();
  89     ok(10, $self->tid == 7, "Wanted 7, got ".$self->tid);
  90     ok(11, threads->tid() == 7, "Wanted 7, got ".threads->tid());
  91 }
  92 threads->create('test7')->join;
  93
  94 sub test8 {
  95     my $self = threads->self();
  96     ok(12, $self->tid == 8, "Wanted 8, got ".$self->tid);
  97     ok(13, threads->tid() == 8, "Wanted 8, got ".threads->tid());
  98 }
  99 threads->create('test8')->join;
 100
 101
 102 ok(14, 0 == threads->self->tid(), "Check so that tid for threads work for main thread");
 103 ok(15, 0 == threads->tid(), "Check so that tid for threads work for main thread");
 104
 105 {
 106     no warnings;
 107     local *CLONE = sub {
 108         ok(16, threads->tid() == 9, "Tid should be correct in the clone");
 109     };
 110     threads->create(sub {
 111         ok(17, threads->tid() == 9, "And tid be 9 here too");
 112     })->join();
 113 }
 114
 115 {
 116     sub Foo::DESTROY {
 117         ok(19, threads->tid() == 10, "In destroy it should be correct too" )
 118     }
 119     my $foo;
 120     threads->create(sub {
 121         ok(18, threads->tid() == 10, "And tid be 10 here");
 122         $foo = bless {}, 'Foo';
 123         return undef;
 124     })->join();
 125 }
 126
 127
 128 my $thr1 = threads->create(sub {});
 129 my $thr2 = threads->create(sub {});
 130 my $thr3 = threads->object($thr1->tid());
 131
 132 # Make sure both overloaded '==' and '!=' are working correctly
 133 ok(20,   $thr1 != $thr2,  'Treads not equal');
 134 ok(21, !($thr1 == $thr2), 'Treads not equal');
 135 ok(22,   $thr1 == $thr3,  'Threads equal');
 136 ok(23, !($thr1 != $thr3), 'Threads equal');
 137
 138 ok(24, $thr1->_handle(), 'Handle method');
 139 ok(25, $thr2->_handle(), 'Handle method');
 140
 141 ok(26, threads->object($thr1->tid())->tid() == 11, 'Object method');
 142 ok(27, threads->object($thr2->tid())->tid() == 12, 'Object method');
 143
 144 $thr1->join();
 145 $thr2->join();
 146
 147 my $sub = sub { ok(28, shift() == 1, "Test code ref"); };
 148 threads->create($sub, 1)->join();
 149
 150 my $thrx = threads->object(99);
 151 ok(29, ! defined($thrx), 'No object');
 152 $thrx = threads->object();
 153 ok(30, ! defined($thrx), 'No object');
 154 $thrx = threads->object(undef);
 155 ok(31, ! defined($thrx), 'No object');
 156
 157 threads->import('stringify');
 158 $thr1 = threads->create(sub {});
 159 ok(32, "$thr1" eq $thr1->tid(), 'Stringify');
 160 $thr1->join();
 161
 162 # ->object($tid) works like ->self() when $tid is thread's TID
 163 $thrx = threads->object(threads->tid());
 164 ok(33, defined($thrx), 'Main thread object');
 165 ok(34, 0 == $thrx->tid(), "Check so that tid for threads work for main thread");
 166
 167 exit(0);
 168
 169 # EOF