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 use ExtUtils::testlib;
  15 use strict;
  16 BEGIN { print "1..12\n" };
  17 use threads;
  18
  19
  20
  21 print "ok 1\n";
  22
  23
  24 #########################
  25
  26 # Insert your test code below, the Test module is use()ed here so read
  27 # its man page ( perldoc Test ) for help writing this test script.
  28 #my $bar;
  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
  41
  42
  43 #test passing of simple argument
  44 my $thread = threads->create(sub { ok(2, 'bar' eq $_[0]),"" },"bar");
  45 $thread->join();
  46
  47
  48 #test passing of complex argument
  49
  50 $thread = threads->create(sub { ok(3, 'bar' eq $_[0]->[0]->{foo})},[{foo => 'bar'}]);
  51
  52 $thread->join();
  53
  54
  55 #test execuion of normal sub
  56 sub bar { ok(4,shift() == 1,"") }
  57 threads->create(\&bar,1)->join();
  58
  59
  60 #check Config
  61 ok(5, 1 == $Config::threads,"");
  62
  63 #test trying to detach thread
  64
  65 my $thread1 = threads->create(sub {ok(6,1,"")});
  66
  67 $thread1->detach();
  68 sleep 1;
  69 ok(7,1,"");
  70 #create nested threads
  71 unless($^O eq 'MSWin32') {
  72         my $thread3 = threads->create(sub { threads->create(sub {})})->join();
  73 }
  74
  75
  76 my @threads;
  77 my $i;
  78 unless($^O eq 'MSWin32') {
  79 for(1..25) {
  80         push @threads, threads->create(sub { for(1..100000) { my $i  } threads->create(sub { sleep 2})->join() });
  81 }
  82 foreach my $thread (@threads) {
  83         $thread->join();
  84 }
  85 }
  86 ok(8,1,"");
  87 threads->create(sub {
  88     my $self = threads->self();
  89     ok(9,$self->tid() == 57,"");
  90 })->join();
  91 threads->create(sub {
  92     my $self = threads->self();
  93     ok(10,$self->tid() == 58,"");
  94 })->join();
  95
  96 #check support for threads->self() in main thread
  97 ok(11, 0 == threads->self->tid(),"");
  98 ok(12, 0 == threads->tid(),"Check so that tid for threads work for current tid");
  99
 100
 101
 102
 103
 104
 105
 106
 107
 108