Commit | Line | Data |
---|---|---|
13c1b207 DM |
1 | use warnings; |
2 | ||
b050c948 AB |
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 | use Devel::Peek; | |
27 | use ExtUtils::testlib; | |
28 | use strict; | |
aaf3876d | 29 | BEGIN { print "1..10\n" }; |
b050c948 AB |
30 | use threads; |
31 | use threads::shared; | |
32 | ok(1,1,"loaded"); | |
33 | ||
34 | my $foo; | |
35 | my $bar = "foo"; | |
36 | share($foo); | |
37 | eval { | |
38 | $foo = \$bar; | |
39 | }; | |
a446a88f NIS |
40 | |
41 | ok(2,my $temp1 = $@ =~/^Invalid\b.*shared scalar/, "Wrong error message"); | |
b050c948 AB |
42 | share($bar); |
43 | $foo = \$bar; | |
44 | ok(3, $temp1 = $foo =~/SCALAR/, "Check that is a ref"); | |
45 | ok(4, $$foo eq "foo", "Check that it points to the correct value"); | |
46 | $bar = "yeah"; | |
47 | ok(5, $$foo eq "yeah", "Check that assignment works"); | |
48 | $$foo = "yeah2"; | |
49 | ok(6, $$foo eq "yeah2", "Check that deref assignment works"); | |
50 | threads->create(sub {$bar = "yeah3"})->join(); | |
51 | ok(7, $$foo eq "yeah3", "Check that other thread assignemtn works"); | |
52 | threads->create(sub {$foo = "artur"})->join(); | |
53 | ok(8, $foo eq "artur", "Check that uncopupling the ref works"); | |
54 | my $baz; | |
55 | share($baz); | |
56 | $baz = "original"; | |
57 | $bar = \$baz; | |
58 | $foo = \$bar; | |
59 | ok(9,$$$foo eq 'original', "Check reference chain"); | |
aaf3876d AB |
60 | my($t1,$t2); |
61 | share($t1); | |
62 | share($t2); | |
63 | $t2 = "text"; | |
64 | $t1 = \$t2; | |
65 | threads->create(sub { $t1 = "bar" })->join(); | |
66 | ok(10,$t1 eq 'bar',"Check that assign to a ROK works"); |