1use strict;
2use warnings;
3
4BEGIN {
5    use Config;
6    if (! $Config{'useithreads'}) {
7        print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
8        exit(0);
9    }
10}
11
12use ExtUtils::testlib;
13
14sub 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
28BEGIN {
29    $| = 1;
30    print("1..37\n");   ### Number of tests that will be run ###
31};
32
33use threads;
34use threads::shared;
35ok(1, 1, 'Loaded');
36
37### Start of Testing ###
38
39my ($hobj, $aobj, $sobj) : shared;
40
41$hobj = &share({});
42$aobj = &share([]);
43my $sref = \do{ my $x };
44share($sref);
45$sobj = $sref;
46
47threads->create(sub {
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
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");
69
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");
74
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");
79
80             })->join;
81
82# Test objects in parent thread
83ok(14, ref($hobj) eq 'foo', "hash blessing does work");
84ok(15, ref($aobj) eq 'bar', "array blessing does work");
85ok(16, ref($sobj) eq 'baz', "scalar blessing does work");
86ok(17, $$sobj eq '3', "scalar contents okay");
87
88ok(18, ref($$aobj[0]) eq 'yin', "blessed hash in array");
89ok(19, ref($$aobj[1]) eq 'yang', "blessed array in array");
90ok(20, ref($$aobj[2]) eq 'baz', "blessed scalar in array");
91ok(21, ${$$aobj[2]} eq '3', "blessed scalar in array contents");
92
93ok(22, ref($$hobj{'hash'}) eq 'yin', "blessed hash in hash");
94ok(23, ref($$hobj{'array'}) eq 'yang', "blessed array in hash");
95ok(24, ref($$hobj{'scalar'}) eq 'baz', "blessed scalar in hash");
96ok(25, ${$$hobj{'scalar'}} eq '3', "blessed scalar in hash contents");
97
98threads->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();
120
121# Test reblessing
122ok(26, ref($hobj) eq 'oof', "hash reblessing does work");
123ok(27, ref($aobj) eq 'rab', "array reblessing does work");
124ok(28, ref($sobj) eq 'zab', "scalar reblessing does work");
125ok(29, $$sobj eq 'test', "scalar contents okay");
126
127ok(30, ref($$aobj[0]) eq 'niy', "reblessed hash in array");
128ok(31, ref($$aobj[1]) eq 'gnay', "reblessed array in array");
129ok(32, ref($$aobj[2]) eq 'zab', "reblessed scalar in array");
130ok(33, ${$$aobj[2]} eq 'test', "reblessed scalar in array contents");
131
132ok(34, ref($$hobj{'hash'}) eq 'niy', "reblessed hash in hash");
133ok(35, ref($$hobj{'array'}) eq 'gnay', "reblessed array in hash");
134ok(36, ref($$hobj{'scalar'}) eq 'zab', "reblessed scalar in hash");
135ok(37, ${$$hobj{'scalar'}} eq 'test', "reblessed scalar in hash contents");
136
137exit(0);
138
139# EOF
140