Commit | Line | Data |
13c1b207 |
1 | use warnings; |
b050c948 |
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 |
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 |
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 |
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 |
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 | |