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