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