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
|
use warnings;
BEGIN {
# chdir 't' if -d 't';
# push @INC ,'../lib';
require Config; import Config;
unless ($Config{'useithreads'}) {
print "1..0 # Skip: no useithreads\n";
exit 0;
}
}
sub ok {
my ($id, $ok, $name) = @_;
$name = '' unless defined $name;
# You have to do it this way or VMS will get confused.
print $ok ? "ok $id - $name\n" : "not ok $id - $name\n";
printf "# Failed test at line %d\n", (caller)[2] unless $ok;
return $ok;
}
sub skip {
my ($id, $ok, $name) = @_;
print "ok $id # skip _thrcnt - $name \n";
}
use ExtUtils::testlib;
use strict;
BEGIN { print "1..36\n" };
use threads;
use threads::shared;
my ($hobj, $aobj, $sobj) : shared;
$hobj = &share({});
$aobj = &share([]);
my $sref = \do{ my $x };
share($sref);
$sobj = $sref;
threads->new(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(1, ref($hobj) eq 'foo', "hash blessing does work");
ok(2, ref($aobj) eq 'bar', "array blessing does work");
ok(3, ref($sobj) eq 'baz', "scalar blessing does work");
ok(4, $$sobj eq '3', "scalar contents okay");
ok(5, ref($$aobj[0]) eq 'yin', "blessed hash in array");
ok(6, ref($$aobj[1]) eq 'yang', "blessed array in array");
ok(7, ref($$aobj[2]) eq 'baz', "blessed scalar in array");
ok(8, ${$$aobj[2]} eq '3', "blessed scalar in array contents");
ok(9, ref($$hobj{'hash'}) eq 'yin', "blessed hash in hash");
ok(10, ref($$hobj{'array'}) eq 'yang', "blessed array in hash");
ok(11, ref($$hobj{'scalar'}) eq 'baz', "blessed scalar in hash");
ok(12, ${$$hobj{'scalar'}} eq '3', "blessed scalar in hash contents");
})->join;
# Test objects in parent thread
ok(13, ref($hobj) eq 'foo', "hash blessing does work");
ok(14, ref($aobj) eq 'bar', "array blessing does work");
ok(15, ref($sobj) eq 'baz', "scalar blessing does work");
ok(16, $$sobj eq '3', "scalar contents okay");
ok(17, ref($$aobj[0]) eq 'yin', "blessed hash in array");
ok(18, ref($$aobj[1]) eq 'yang', "blessed array in array");
ok(19, ref($$aobj[2]) eq 'baz', "blessed scalar in array");
ok(20, ${$$aobj[2]} eq '3', "blessed scalar in array contents");
ok(21, ref($$hobj{'hash'}) eq 'yin', "blessed hash in hash");
ok(22, ref($$hobj{'array'}) eq 'yang', "blessed array in hash");
ok(23, ref($$hobj{'scalar'}) eq 'baz', "blessed scalar in hash");
ok(24, ${$$hobj{'scalar'}} eq '3', "blessed scalar in hash contents");
threads->new(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(25, ref($hobj) eq 'oof', "hash reblessing does work");
ok(26, ref($aobj) eq 'rab', "array reblessing does work");
ok(27, ref($sobj) eq 'zab', "scalar reblessing does work");
ok(28, $$sobj eq 'test', "scalar contents okay");
ok(29, ref($$aobj[0]) eq 'niy', "reblessed hash in array");
ok(30, ref($$aobj[1]) eq 'gnay', "reblessed array in array");
ok(31, ref($$aobj[2]) eq 'zab', "reblessed scalar in array");
ok(32, ${$$aobj[2]} eq 'test', "reblessed scalar in array contents");
ok(33, ref($$hobj{'hash'}) eq 'niy', "reblessed hash in hash");
ok(34, ref($$hobj{'array'}) eq 'gnay', "reblessed array in hash");
ok(35, ref($$hobj{'scalar'}) eq 'zab', "reblessed scalar in hash");
ok(36, ${$$hobj{'scalar'}} eq 'test', "reblessed scalar in hash contents");
|
