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