ext/threads/t/basic.t

   1
   2
   3 #
   4 # The reason this does not use a Test module is that
   5 # they mess up test numbers between threads
   6 #
   7 # And even when that will be fixed, this is a basic
   8 # test and should not rely on shared variables
   9 #
  10 #
  11 #########################
  12
  13
  14 BEGIN {
  15     chdir 't' if -d 't';
  16     @INC = '../lib';
  17     require Config; import Config;
  18     unless ($Config{'useithreads'}) {
  19         print "1..0 # Skip: no useithreads\n";
  20         exit 0;
  21     }
  22 }
  23
  24 use ExtUtils::testlib;
  25 use strict;
  26 BEGIN { print "1..12\n" };
  27 use threads;
  28
  29
  30
  31 print "ok 1\n";
  32
  33
  34 #########################
  35
  36 # Insert your test code below, the Test module is use()ed here so read
  37 # its man page ( perldoc Test ) for help writing this test script.
  38 #my $bar;
  39 sub ok {
  40     my ($id, $ok, $name) = @_;
  41
  42     # You have to do it this way or VMS will get confused.
  43     print $ok ? "ok $id - $name\n" : "not ok $id - $name\n";
  44
  45     printf "# Failed test at line %d\n", (caller)[2] unless $ok;
  46
  47     return $ok;
  48 }
  49
  50
  51
  52
  53 #test passing of simple argument
  54 my $thread = threads->create(sub { ok(2, 'bar' eq $_[0]),"" },"bar");
  55 $thread->join();
  56
  57
  58 #test passing of complex argument
  59
  60 $thread = threads->create(sub { ok(3, 'bar' eq $_[0]->[0]->{foo})},[{foo => 'bar'}]);
  61
  62 $thread->join();
  63
  64
  65 #test execuion of normal sub
  66 sub bar { ok(4,shift() == 1,"") }
  67 threads->create(\&bar,1)->join();
  68
  69
  70 #check Config
  71 ok(5, 1 == $Config::threads,"");
  72
  73 #test trying to detach thread
  74
  75 my $thread1 = threads->create(sub {ok(6,1,"")});
  76
  77 $thread1->detach();
  78 sleep 1;
  79 ok(7,1,"");
  80 #create nested threads
  81 unless($^O eq 'MSWin32') {
  82         my $thread3 = threads->create(sub { threads->create(sub {})})->join();
  83 }
  84
  85
  86 my @threads;
  87 my $i;
  88 unless($^O eq 'MSWin32') {
  89 for(1..25) {
  90         push @threads, threads->create(sub { for(1..100000) { my $i  } threads->create(sub { sleep 2})->join() });
  91 }
  92 foreach my $thread (@threads) {
  93         $thread->join();
  94 }
  95 }
  96 ok(8,1,"");
  97 threads->create(sub {
  98     my $self = threads->self();
  99     ok(9,$self->tid() == 57,"");
 100 })->join();
 101 threads->create(sub {
 102     my $self = threads->self();
 103     ok(10,$self->tid() == 58,"");
 104 })->join();
 105
 106 #check support for threads->self() in main thread
 107 ok(11, 0 == threads->self->tid(),"");
 108 ok(12, 0 == threads->tid(),"Check so that tid for threads work for current tid");
 109
 110
 111
 112
 113
 114
 115
 116
 117
 118