Commit | Line | Data |
13c1b207 |
1 | use warnings; |
2 | |
b050c948 |
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 | } |
4946def6 |
11 | if ($Config{'extensions'} !~ /\bDevel\/Peek\b/) { |
12 | print "1..0 # Skip: Devel::Peek was not built\n"; |
13 | exit 0; |
14 | } |
b050c948 |
15 | } |
16 | |
17 | |
18 | sub ok { |
19 | my ($id, $ok, $name) = @_; |
20 | |
13c1b207 |
21 | $name = '' unless defined $name; |
b050c948 |
22 | # You have to do it this way or VMS will get confused. |
23 | print $ok ? "ok $id - $name\n" : "not ok $id - $name\n"; |
24 | |
25 | printf "# Failed test at line %d\n", (caller)[2] unless $ok; |
26 | |
27 | return $ok; |
28 | } |
29 | |
30 | use Devel::Peek; |
31 | use ExtUtils::testlib; |
32 | use strict; |
aaf3876d |
33 | BEGIN { print "1..10\n" }; |
b050c948 |
34 | use threads; |
35 | use threads::shared; |
36 | ok(1,1,"loaded"); |
37 | |
38 | my $foo; |
39 | my $bar = "foo"; |
40 | share($foo); |
41 | eval { |
42 | $foo = \$bar; |
43 | }; |
a446a88f |
44 | |
45 | ok(2,my $temp1 = $@ =~/^Invalid\b.*shared scalar/, "Wrong error message"); |
b050c948 |
46 | share($bar); |
47 | $foo = \$bar; |
48 | ok(3, $temp1 = $foo =~/SCALAR/, "Check that is a ref"); |
49 | ok(4, $$foo eq "foo", "Check that it points to the correct value"); |
50 | $bar = "yeah"; |
51 | ok(5, $$foo eq "yeah", "Check that assignment works"); |
52 | $$foo = "yeah2"; |
53 | ok(6, $$foo eq "yeah2", "Check that deref assignment works"); |
54 | threads->create(sub {$bar = "yeah3"})->join(); |
55 | ok(7, $$foo eq "yeah3", "Check that other thread assignemtn works"); |
56 | threads->create(sub {$foo = "artur"})->join(); |
57 | ok(8, $foo eq "artur", "Check that uncopupling the ref works"); |
58 | my $baz; |
59 | share($baz); |
60 | $baz = "original"; |
61 | $bar = \$baz; |
62 | $foo = \$bar; |
63 | ok(9,$$$foo eq 'original', "Check reference chain"); |
aaf3876d |
64 | my($t1,$t2); |
65 | share($t1); |
66 | share($t2); |
67 | $t2 = "text"; |
68 | $t1 = \$t2; |
69 | threads->create(sub { $t1 = "bar" })->join(); |
70 | ok(10,$t1 eq 'bar',"Check that assign to a ROK works"); |