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