This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Port testcases from thr5005 tests so we don't fail on same things.
[perl5.git] / ext / threads / t / thread.t
CommitLineData
f9dff5f5
AB
1
2BEGIN {
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
12use ExtUtils::testlib;
13use strict;
14BEGIN { $| = 1; print "1..22\n" };
15use threads;
16use threads::shared;
17
18print "ok 1\n";
19
20sub 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
39sub 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 }
72my $t = threads->new(\&islocked, "ok 13\n", "ok 14\n");
73$t->join->join;
74}
75
76
77
78sub 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
88sub 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
105EOT
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