Move threads::shared from ext/ to dist/
[perl.git] / dist / threads-shared / t / clone.t
1 use strict;
2 use warnings;
3
4 BEGIN {
5     use Config;
6     if (! $Config{'useithreads'}) {
7         print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
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;
30     print("1..34\n");   ### Number of tests that will be run ###
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 {
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 {
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');
130     ok($test++, ($] < 5.008003) || Internals::SvREADONLY($$bork), 'read-only');
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');
135         ok($test++, ($] < 5.008003) || Internals::SvREADONLY($$bork), 'read-only');
136         ok($test++, ref($bork) eq 'Bork', 'Object class');
137     })->join();
138
139     $test += 3;
140 }
141
142 {
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
173 exit(0);
174
175 # EOF