Commit | Line | Data |
b050c948 |
1 | |
2 | |
3 | |
4 | |
5 | BEGIN { |
6 | # chdir 't' if -d 't'; |
7 | # push @INC ,'../lib'; |
8 | require Config; import Config; |
9 | unless ($Config{'useithreads'}) { |
10 | print "1..0 # Skip: no useithreads\n"; |
11 | exit 0; |
12 | } |
13 | } |
14 | |
15 | |
16 | sub ok { |
17 | my ($id, $ok, $name) = @_; |
18 | |
19 | # You have to do it this way or VMS will get confused. |
20 | print $ok ? "ok $id - $name\n" : "not ok $id - $name\n"; |
21 | |
22 | printf "# Failed test at line %d\n", (caller)[2] unless $ok; |
23 | |
24 | return $ok; |
25 | } |
26 | |
27 | |
28 | use ExtUtils::testlib; |
29 | use strict; |
30 | BEGIN { print "1..10\n" }; |
31 | use threads; |
32 | use threads::shared; |
33 | ok(1,1,"loaded"); |
34 | my $test = "bar"; |
35 | share($test); |
36 | ok(2,$test eq "bar","Test magic share fetch"); |
37 | $test = "foo"; |
38 | ok(3,$test eq "foo","Test magic share assign"); |
a446a88f |
39 | my $c = threads::shared::_thrcnt($test); |
b050c948 |
40 | threads->create( |
41 | sub { |
a446a88f |
42 | ok(4, $test eq "foo","Test magic share fetch after thread"); |
b050c948 |
43 | $test = "baz"; |
a446a88f |
44 | ok(5,threads::shared::_thrcnt($test) > $c, "Check that threadcount is correct"); |
b050c948 |
45 | })->join(); |
46 | ok(6,$test eq "baz","Test that value has changed in another thread"); |
a446a88f |
47 | ok(7,threads::shared::_thrcnt($test) == $c,"Check thrcnt is down properly"); |
b050c948 |
48 | $test = "barbar"; |
49 | ok(8, length($test) == 6, "Check length code"); |
50 | threads->create(sub { $test = "barbarbar" })->join; |
51 | ok(9, length($test) == 9, "Check length code after different thread modified it"); |
52 | threads->create(sub { undef($test)})->join(); |
53 | ok(10, !defined($test), "Check undef value"); |
54 | |
55 | |
56 | |
57 | |
58 | |
59 | |
60 | |