Commit | Line | Data |
7473853a |
1 | use strict; |
cd8d64a7 |
2 | use warnings; |
3 | |
4 | BEGIN { |
7473853a |
5 | if ($ENV{'PERL_CORE'}){ |
6 | chdir 't'; |
7 | unshift @INC, '../lib'; |
8 | } |
9 | use Config; |
10 | if (! $Config{'useithreads'}) { |
11 | print("1..0 # Skip: Perl not compiled with 'useithreads'\n"); |
12 | exit(0); |
cd8d64a7 |
13 | } |
14 | } |
15 | |
7473853a |
16 | use ExtUtils::testlib; |
cd8d64a7 |
17 | |
18 | sub ok { |
19 | my ($id, $ok, $name) = @_; |
20 | |
cd8d64a7 |
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 | } |
cd8d64a7 |
28 | |
7473853a |
29 | return ($ok); |
cd8d64a7 |
30 | } |
31 | |
7473853a |
32 | BEGIN { |
33 | $| = 1; |
34 | print("1..37\n"); ### Number of tests that will be run ### |
35 | }; |
cd8d64a7 |
36 | |
cd8d64a7 |
37 | use threads; |
38 | use threads::shared; |
7473853a |
39 | ok(1, 1, 'Loaded'); |
40 | |
41 | ### Start of Testing ### |
cd8d64a7 |
42 | |
43 | my ($hobj, $aobj, $sobj) : shared; |
44 | |
45 | $hobj = &share({}); |
46 | $aobj = &share([]); |
47 | my $sref = \do{ my $x }; |
48 | share($sref); |
49 | $sobj = $sref; |
50 | |
878090d5 |
51 | threads->create(sub { |
cd8d64a7 |
52 | # Bless objects |
53 | bless $hobj, 'foo'; |
54 | bless $aobj, 'bar'; |
55 | bless $sobj, 'baz'; |
56 | |
57 | # Add data to objects |
58 | $$aobj[0] = bless(&share({}), 'yin'); |
59 | $$aobj[1] = bless(&share([]), 'yang'); |
60 | $$aobj[2] = $sobj; |
61 | |
62 | $$hobj{'hash'} = bless(&share({}), 'yin'); |
63 | $$hobj{'array'} = bless(&share([]), 'yang'); |
64 | $$hobj{'scalar'} = $sobj; |
65 | |
66 | $$sobj = 3; |
67 | |
68 | # Test objects in child thread |
7473853a |
69 | ok(2, ref($hobj) eq 'foo', "hash blessing does work"); |
70 | ok(3, ref($aobj) eq 'bar', "array blessing does work"); |
71 | ok(4, ref($sobj) eq 'baz', "scalar blessing does work"); |
72 | ok(5, $$sobj eq '3', "scalar contents okay"); |
cd8d64a7 |
73 | |
7473853a |
74 | ok(6, ref($$aobj[0]) eq 'yin', "blessed hash in array"); |
75 | ok(7, ref($$aobj[1]) eq 'yang', "blessed array in array"); |
76 | ok(8, ref($$aobj[2]) eq 'baz', "blessed scalar in array"); |
77 | ok(9, ${$$aobj[2]} eq '3', "blessed scalar in array contents"); |
cd8d64a7 |
78 | |
7473853a |
79 | ok(10, ref($$hobj{'hash'}) eq 'yin', "blessed hash in hash"); |
80 | ok(11, ref($$hobj{'array'}) eq 'yang', "blessed array in hash"); |
81 | ok(12, ref($$hobj{'scalar'}) eq 'baz', "blessed scalar in hash"); |
82 | ok(13, ${$$hobj{'scalar'}} eq '3', "blessed scalar in hash contents"); |
cd8d64a7 |
83 | |
84 | })->join; |
85 | |
86 | # Test objects in parent thread |
7473853a |
87 | ok(14, ref($hobj) eq 'foo', "hash blessing does work"); |
88 | ok(15, ref($aobj) eq 'bar', "array blessing does work"); |
89 | ok(16, ref($sobj) eq 'baz', "scalar blessing does work"); |
90 | ok(17, $$sobj eq '3', "scalar contents okay"); |
cd8d64a7 |
91 | |
7473853a |
92 | ok(18, ref($$aobj[0]) eq 'yin', "blessed hash in array"); |
93 | ok(19, ref($$aobj[1]) eq 'yang', "blessed array in array"); |
94 | ok(20, ref($$aobj[2]) eq 'baz', "blessed scalar in array"); |
95 | ok(21, ${$$aobj[2]} eq '3', "blessed scalar in array contents"); |
cd8d64a7 |
96 | |
7473853a |
97 | ok(22, ref($$hobj{'hash'}) eq 'yin', "blessed hash in hash"); |
98 | ok(23, ref($$hobj{'array'}) eq 'yang', "blessed array in hash"); |
99 | ok(24, ref($$hobj{'scalar'}) eq 'baz', "blessed scalar in hash"); |
100 | ok(25, ${$$hobj{'scalar'}} eq '3', "blessed scalar in hash contents"); |
cd8d64a7 |
101 | |
2a6601ce |
102 | threads->new(sub { |
cd8d64a7 |
103 | # Rebless objects |
104 | bless $hobj, 'oof'; |
105 | bless $aobj, 'rab'; |
106 | bless $sobj, 'zab'; |
107 | |
108 | my $data = $$aobj[0]; |
109 | bless $data, 'niy'; |
110 | $$aobj[0] = $data; |
111 | $data = $$aobj[1]; |
112 | bless $data, 'gnay'; |
113 | $$aobj[1] = $data; |
114 | |
115 | $data = $$hobj{'hash'}; |
116 | bless $data, 'niy'; |
117 | $$hobj{'hash'} = $data; |
118 | $data = $$hobj{'array'}; |
119 | bless $data, 'gnay'; |
120 | $$hobj{'array'} = $data; |
121 | |
122 | $$sobj = 'test'; |
123 | })->join; |
124 | |
125 | # Test reblessing |
7473853a |
126 | ok(26, ref($hobj) eq 'oof', "hash reblessing does work"); |
127 | ok(27, ref($aobj) eq 'rab', "array reblessing does work"); |
128 | ok(28, ref($sobj) eq 'zab', "scalar reblessing does work"); |
129 | ok(29, $$sobj eq 'test', "scalar contents okay"); |
130 | |
131 | ok(30, ref($$aobj[0]) eq 'niy', "reblessed hash in array"); |
132 | ok(31, ref($$aobj[1]) eq 'gnay', "reblessed array in array"); |
133 | ok(32, ref($$aobj[2]) eq 'zab', "reblessed scalar in array"); |
134 | ok(33, ${$$aobj[2]} eq 'test', "reblessed scalar in array contents"); |
135 | |
136 | ok(34, ref($$hobj{'hash'}) eq 'niy', "reblessed hash in hash"); |
137 | ok(35, ref($$hobj{'array'}) eq 'gnay', "reblessed array in hash"); |
138 | ok(36, ref($$hobj{'scalar'}) eq 'zab', "reblessed scalar in hash"); |
139 | ok(37, ${$$hobj{'scalar'}} eq 'test', "reblessed scalar in hash contents"); |
140 | |
141 | # EOF |