4 push @INC, '../lib','.';
5 require Config; import Config;
6 unless ($Config{'useithreads'}) {
7 print "1..0 # Skip: no useithreads\n";
13 use ExtUtils::testlib;
15 BEGIN { $| = 1; print "1..26\n" };
26 my $t = threads->new(\&content, "ok 2\n", "ok 3\n", 1..1000);
34 $t = threads->new(sub { lock($lock); print "ok 5\n"});
45 $ret = threads->new(\&dorecurse, @_);
50 my $t = threads->new(\&dorecurse, map { "ok $_\n" } 6..10);
55 # test that sleep lets other thread run
56 my $t = threads->new(\&dorecurse, "ok 11\n");
57 threads->yield; # help out non-preemptive thread implementations
70 $ret = threads->new(\&islocked, shift);
74 my $t = threads->new(\&islocked, "ok 13\n", "ok 14\n");
82 my $same = sprintf( "%0.f", $testno);
83 return $testno eq $same;
87 my ($string, $string_end) = @_;
89 # Do the match, saving the output in appropriate variables
90 $string =~ /(.*)(is)(.*)/;
91 # Yield control, allowing the other thread to fill in the match variables
93 # Examine the match variable contents; on broken perls this fails
94 return $3 eq $string_end;
101 my $thr1 = threads->new(\&testsprintf, 15);
102 my $thr2 = threads->new(\&testsprintf, 16);
104 my $short = "This is a long string that goes on and on.";
105 my $shorte = " a long string that goes on and on.";
106 my $long = "This is short.";
107 my $longe = " short.";
108 my $foo = "This is bar bar bar.";
109 my $fooe = " bar bar bar.";
110 my $thr3 = new threads \&threaded, $short, $shorte;
111 my $thr4 = new threads \&threaded, $long, $longe;
112 my $thr5 = new threads \&testsprintf, 19;
113 my $thr6 = new threads \&testsprintf, 20;
114 my $thr7 = new threads \&threaded, $foo, $fooe;
125 # test that 'yield' is importable
139 my $th = async {return 1 };
144 # there is a little chance this test case will falsly fail
145 # since it tests rand
148 threads->new( sub { $rand{int(rand(10000000000))}++ } ) foreach 1..25;
149 $_->join foreach threads->list;
150 # use Data::Dumper qw(Dumper);
151 # print Dumper(\%rand);
153 ok((keys %rand == 25), "Check that rand works after a new thread");
159 'use threads; sub a{threads->new(shift)} $t = a sub{}; $t->tid; $t->join; $t->tid');
160 is($?, 0, 'coredump in global destruction');