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