Commit | Line | Data |
7473853a |
1 | use strict; |
13c1b207 |
2 | use warnings; |
3 | |
b050c948 |
4 | BEGIN { |
7473853a |
5 | if ($ENV{'PERL_CORE'}){ |
6 | chdir 't'; |
7 | unshift @INC, '../lib'; |
b050c948 |
8 | } |
7473853a |
9 | use Config; |
10 | if (! $Config{'useithreads'}) { |
11 | print("1..0 # Skip: Perl not compiled with 'useithreads'\n"); |
12 | exit(0); |
4946def6 |
13 | } |
b050c948 |
14 | } |
15 | |
7473853a |
16 | use ExtUtils::testlib; |
b050c948 |
17 | |
18 | sub ok { |
19 | my ($id, $ok, $name) = @_; |
20 | |
21 | # You have to do it this way or VMS will get confused. |
7473853a |
22 | if ($ok) { |
23 | print("ok $id - $name\n"); |
24 | } else { |
25 | print("not ok $id - $name\n"); |
26 | printf("# Failed test at line %d\n", (caller)[2]); |
27 | } |
b050c948 |
28 | |
7473853a |
29 | return ($ok); |
b050c948 |
30 | } |
31 | |
7473853a |
32 | BEGIN { |
33 | $| = 1; |
f6d55995 |
34 | print("1..21\n"); ### Number of tests that will be run ### |
7473853a |
35 | }; |
36 | |
b050c948 |
37 | use threads; |
38 | use threads::shared; |
7473853a |
39 | ok(1, 1, 'Loaded'); |
40 | |
41 | ### Start of Testing ### |
b050c948 |
42 | |
43 | my $foo; |
44 | my $bar = "foo"; |
45 | share($foo); |
7473853a |
46 | eval { $foo = \$bar; }; |
a446a88f |
47 | ok(2,my $temp1 = $@ =~/^Invalid\b.*shared scalar/, "Wrong error message"); |
7473853a |
48 | |
b050c948 |
49 | share($bar); |
50 | $foo = \$bar; |
51 | ok(3, $temp1 = $foo =~/SCALAR/, "Check that is a ref"); |
52 | ok(4, $$foo eq "foo", "Check that it points to the correct value"); |
53 | $bar = "yeah"; |
54 | ok(5, $$foo eq "yeah", "Check that assignment works"); |
55 | $$foo = "yeah2"; |
56 | ok(6, $$foo eq "yeah2", "Check that deref assignment works"); |
57 | threads->create(sub {$bar = "yeah3"})->join(); |
58 | ok(7, $$foo eq "yeah3", "Check that other thread assignemtn works"); |
59 | threads->create(sub {$foo = "artur"})->join(); |
60 | ok(8, $foo eq "artur", "Check that uncopupling the ref works"); |
61 | my $baz; |
62 | share($baz); |
63 | $baz = "original"; |
64 | $bar = \$baz; |
65 | $foo = \$bar; |
66 | ok(9,$$$foo eq 'original', "Check reference chain"); |
aaf3876d |
67 | my($t1,$t2); |
68 | share($t1); |
69 | share($t2); |
70 | $t2 = "text"; |
71 | $t1 = \$t2; |
72 | threads->create(sub { $t1 = "bar" })->join(); |
73 | ok(10,$t1 eq 'bar',"Check that assign to a ROK works"); |
7473853a |
74 | |
75 | ok(11, is_shared($foo), "Check for sharing"); |
76 | |
f6d55995 |
77 | { |
78 | # Circular references with 3 shared scalars |
79 | my $x : shared; |
80 | my $y : shared; |
81 | my $z : shared; |
82 | |
83 | $x = \$y; |
84 | $y = \$z; |
85 | $z = \$x; |
86 | ok(12, ref($x) eq 'REF', '$x ref type'); |
87 | ok(13, ref($y) eq 'REF', '$y ref type'); |
88 | ok(14, ref($z) eq 'REF', '$z ref type'); |
89 | |
90 | my @q :shared = ($x); |
91 | ok(15, ref($q[0]) eq 'REF', '$q[0] ref type'); |
92 | |
93 | my $w = $q[0]; |
94 | ok(16, ref($w) eq 'REF', '$w ref type'); |
95 | ok(17, ref($$w) eq 'REF', '$$w ref type'); |
96 | ok(18, ref($$$w) eq 'REF', '$$$w ref type'); |
97 | ok(19, ref($$$$w) eq 'REF', '$$$$w ref type'); |
98 | |
99 | ok(20, is_shared($x) == is_shared($w), '_id($x) == _id($w)'); |
100 | ok(21, is_shared($w) == is_shared($$$$w), '_id($w) == _id($$$$w)'); |
101 | } |
102 | |
7473853a |
103 | # EOF |