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 unless($^O eq 'MSWin32') {
  87     my @threads;
  88     my $i;
  89     for(1..25) {
  90         push @threads,
  91             threads->create(
  92                             sub {
  93                                 for(1..100000) { my $i  }
  94                                 threads->create(
  95                                                 sub {sleep 2})
  96                                     ->join()
  97                                 }
  98                            );
  99     }
 100     foreach my $thread (@threads) {
 101         $thread->join();
 102     }
 103 }
 104 ok(8,1,"");
 105 threads->create(sub {
 106     my $self = threads->self();
 107     ok(9,$self->tid() == 57,"");
 108 })->join();
 109 threads->create(sub {
 110     my $self = threads->self();
 111     ok(10,$self->tid() == 58,"");
 112 })->join();
 113
 114 #check support for threads->self() in main thread
 115 ok(11, 0 == threads->self->tid(),"");
 116 ok(12, 0 == threads->tid(),"Check so that tid for threads work for current tid");
 117
 118
 119
 120
 121
 122
 123
 124
 125
 126