ext/threads/t/thread.t

   1
   2 BEGIN {
   3     chdir 't' if -d 't';
   4     @INC = '../lib';
   5     require Config; import Config;
   6     unless ($Config{'useithreads'}) {
   7         print "1..0 # Skip: no useithreads\n";
   8         exit 0;
   9     }
  10 }
  11
  12 use ExtUtils::testlib;
  13 use strict;
  14 BEGIN { $| = 1; print "1..22\n" };
  15 use threads;
  16 use threads::shared;
  17
  18 print "ok 1\n";
  19
  20 sub content {
  21     print shift;
  22     return shift;
  23 }
  24 {
  25     my $t = threads->new(\&content, "ok 2\n", "ok 3\n", 1..1000);
  26     print $t->join();
  27 }
  28 {
  29     my $lock : shared;
  30     my $t;
  31     {
  32         lock($lock);
  33         $t = threads->new(sub { lock($lock); print "ok 5\n"});
  34         print "ok 4\n";
  35     }
  36     $t->join();
  37 }
  38
  39 sub dorecurse {
  40     my $val = shift;
  41     my $ret;
  42     print $val;
  43     if(@_) {
  44         $ret = threads->new(\&dorecurse, @_);
  45         $ret->join;
  46     }
  47 }
  48 {
  49     my $t = threads->new(\&dorecurse, map { "ok $_\n" } 6..10);
  50     $t->join();
  51 }
  52
  53 {
  54     # test that sleep lets other thread run
  55     my $t = threads->new(\&dorecurse, "ok 11\n");
  56     sleep 1;
  57     print "ok 12\n";
  58     $t->join();
  59 }
  60 {
  61     my $lock : shared;
  62     sub islocked {
  63         lock($lock);
  64         my $val = shift;
  65         my $ret;
  66         print $val;
  67         if (@_) {
  68             $ret = threads->new(\&islocked, shift);
  69         }
  70         return $ret;
  71     }
  72 my $t = threads->new(\&islocked, "ok 13\n", "ok 14\n");
  73 $t->join->join;
  74 }
  75
  76
  77
  78 sub testsprintf {
  79     my $testno = shift;
  80     my $same = sprintf( "%0.f", $testno);
  81     if($testno eq $same) {
  82         print "ok $testno\n";
  83     } else {
  84         print "not ok $testno\t# '$testno' ne '$same'\n";
  85     }
  86 }
  87
  88 sub threaded {
  89     my ($string, $string_end, $testno) = @_;
  90
  91   # Do the match, saving the output in appropriate variables
  92     $string =~ /(.*)(is)(.*)/;
  93   # Yield control, allowing the other thread to fill in the match variables
  94     threads->yield();
  95   # Examine the match variable contents; on broken perls this fails
  96     if ($3 eq $string_end) {
  97         print "ok $testno\n";
  98     }
  99     else {
 100         warn <<EOT;
 101 #
 102 # This is a 5005thread failure that should be gone in ithreads
 103 # $3 - $string_end
 104
 105 EOT
 106    print "not ok $testno # other thread filled in match variables\n";
 107    }
 108 }
 109
 110
 111 {
 112     my $thr1 = threads->new(\&testsprintf, 15);
 113     my $thr2 = threads->new(\&testsprintf, 16);
 114
 115     my $short = "This is a long string that goes on and on.";
 116     my $shorte = " a long string that goes on and on.";
 117     my $long  = "This is short.";
 118     my $longe  = " short.";
 119     my $foo = "This is bar bar bar.";
 120     my $fooe = " bar bar bar.";
 121     my $thr3 = new threads \&threaded, $short, $shorte, "17";
 122     my $thr4 = new threads \&threaded, $long, $longe, "18";
 123     my $thr5 = new threads \&testsprintf, "19";
 124     my $thr6 = threads->new(\&testsprintf, 20);
 125     my $thr7 = new threads \&threaded, $foo, $fooe, "21";
 126
 127
 128
 129     $thr1->join();
 130     $thr2->join();
 131     $thr3->join();
 132     $thr4->join();
 133     $thr5->join();
 134     $thr6->join();
 135     $thr7->join();
 136     print "ok 22\n";
 137 }
 138
 139