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