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