Commit | Line | Data |
373098c0 |
1 | use strict; |
2 | use warnings; |
3 | |
4 | BEGIN { |
5 | if ($ENV{'PERL_CORE'}){ |
6 | chdir 't'; |
7 | unshift @INC, '../lib'; |
8 | } |
9 | use Config; |
10 | if (! $Config{'useithreads'}) { |
6c791b15 |
11 | print("1..0 # SKIP Perl not compiled with 'useithreads'\n"); |
373098c0 |
12 | exit(0); |
13 | } |
14 | } |
15 | |
16 | use ExtUtils::testlib; |
17 | |
18 | sub ok { |
19 | my ($id, $ok, $name) = @_; |
20 | |
21 | # You have to do it this way or VMS will get confused. |
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 | } |
28 | |
29 | return ($ok); |
30 | } |
31 | |
32 | BEGIN { |
33 | $| = 1; |
a469502f |
34 | print("1..34\n"); ### Number of tests that will be run ### |
373098c0 |
35 | }; |
36 | |
37 | my $test = 1; |
38 | |
39 | use threads; |
40 | use threads::shared; |
41 | ok($test++, 1, 'Loaded'); |
42 | |
43 | ### Start of Testing ### |
44 | |
45 | { |
373098c0 |
46 | my $x = shared_clone(14); |
47 | ok($test++, $x == 14, 'number'); |
48 | |
49 | $x = shared_clone('test'); |
50 | ok($test++, $x eq 'test', 'string'); |
51 | } |
52 | |
53 | { |
54 | my %hsh = ('foo' => 2); |
55 | eval { |
56 | my $x = shared_clone(%hsh); |
57 | }; |
58 | ok($test++, $@ =~ /Usage:/, '1 arg'); |
59 | |
60 | threads->create(sub {})->join(); # Hide leaks, etc. |
61 | } |
62 | |
63 | { |
64 | my $x = 'test'; |
65 | my $foo :shared = shared_clone($x); |
66 | ok($test++, $foo eq 'test', 'cloned string'); |
67 | |
68 | $foo = shared_clone(\$x); |
69 | ok($test++, $$foo eq 'test', 'cloned scalar ref'); |
70 | |
71 | threads->create(sub { |
72 | ok($test++, $$foo eq 'test', 'cloned scalar ref in thread'); |
73 | })->join(); |
74 | |
75 | $test++; |
76 | } |
77 | |
78 | { |
79 | my $foo :shared; |
80 | $foo = shared_clone(\$foo); |
81 | ok($test++, ref($foo) eq 'REF', 'Circular ref typ'); |
82 | ok($test++, threads::shared::_id($foo) == threads::shared::_id($$foo), 'Circular ref'); |
83 | |
84 | threads->create(sub { |
85 | ok($test++, threads::shared::_id($foo) == threads::shared::_id($$foo), 'Circular ref in thread'); |
86 | |
87 | my ($x, $y, $z); |
88 | $x = \$y; $y = \$z; $z = \$x; |
89 | $foo = shared_clone($x); |
90 | })->join(); |
91 | |
92 | $test++; |
93 | |
94 | ok($test++, threads::shared::_id($$foo) == threads::shared::_id($$$$$foo), |
95 | 'Cloned circular refs from thread'); |
96 | } |
97 | |
98 | { |
99 | my @ary = (qw/foo bar baz/); |
100 | my $ary = shared_clone(\@ary); |
101 | |
102 | ok($test++, $ary->[1] eq 'bar', 'Cloned array'); |
103 | $ary->[1] = 99; |
104 | ok($test++, $ary->[1] == 99, 'Clone mod'); |
105 | ok($test++, $ary[1] eq 'bar', 'Original array'); |
106 | |
107 | threads->create(sub { |
108 | ok($test++, $ary->[1] == 99, 'Clone mod in thread'); |
109 | |
110 | $ary[1] = 'bork'; |
111 | $ary->[1] = 'thread'; |
112 | })->join(); |
113 | |
114 | $test++; |
115 | |
116 | ok($test++, $ary->[1] eq 'thread', 'Clone mod from thread'); |
117 | ok($test++, $ary[1] eq 'bar', 'Original array'); |
118 | } |
119 | |
120 | { |
a469502f |
121 | my $hsh :shared = shared_clone({'foo' => [qw/foo bar baz/]}); |
122 | ok($test++, is_shared($hsh), 'Shared hash ref'); |
123 | ok($test++, is_shared($hsh->{'foo'}), 'Shared hash ref elem'); |
124 | ok($test++, $$hsh{'foo'}[1] eq 'bar', 'Cloned structure'); |
125 | } |
126 | |
127 | { |
128 | my $obj = \do { my $bork = 99; }; |
129 | bless($obj, 'Bork'); |
130 | Internals::SvREADONLY($$obj, 1) if ($] >= 5.008003); |
131 | |
132 | my $bork = shared_clone($obj); |
133 | ok($test++, $$bork == 99, 'cloned scalar ref object'); |
e4ddb720 |
134 | ok($test++, ($] < 5.008003) || Internals::SvREADONLY($$bork), 'read-only'); |
a469502f |
135 | ok($test++, ref($bork) eq 'Bork', 'Object class'); |
136 | |
137 | threads->create(sub { |
138 | ok($test++, $$bork == 99, 'cloned scalar ref object in thread'); |
e4ddb720 |
139 | ok($test++, ($] < 5.008003) || Internals::SvREADONLY($$bork), 'read-only'); |
a469502f |
140 | ok($test++, ref($bork) eq 'Bork', 'Object class'); |
141 | })->join(); |
142 | |
143 | $test += 3; |
144 | } |
145 | |
146 | { |
373098c0 |
147 | my $scalar = 'zip'; |
148 | |
149 | my $obj = { |
150 | 'ary' => [ 1, 'foo', [ 86 ], { 'bar' => [ 'baz' ] } ], |
151 | 'ref' => \$scalar, |
152 | }; |
153 | |
154 | $obj->{'self'} = $obj; |
155 | |
156 | bless($obj, 'Foo'); |
157 | |
158 | my $copy :shared; |
159 | |
160 | threads->create(sub { |
161 | $copy = shared_clone($obj); |
162 | |
163 | ok($test++, ${$copy->{'ref'}} eq 'zip', 'Obj ref in thread'); |
164 | ok($test++, threads::shared::_id($copy) == threads::shared::_id($copy->{'self'}), 'Circular ref in cloned obj'); |
165 | ok($test++, is_shared($copy->{'ary'}->[2]), 'Shared element in cloned obj'); |
166 | })->join(); |
167 | |
168 | $test += 3; |
169 | |
170 | ok($test++, ref($copy) eq 'Foo', 'Obj cloned by thread'); |
171 | ok($test++, ${$copy->{'ref'}} eq 'zip', 'Obj ref in thread'); |
172 | ok($test++, threads::shared::_id($copy) == threads::shared::_id($copy->{'self'}), 'Circular ref in cloned obj'); |
173 | ok($test++, $copy->{'ary'}->[3]->{'bar'}->[0] eq 'baz', 'Deeply cloned'); |
174 | ok($test++, ref($copy) eq 'Foo', 'Cloned object class'); |
175 | } |
176 | |
6c791b15 |
177 | exit(0); |
178 | |
373098c0 |
179 | # EOF |