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
1 use strict;
2 use warnings;
3
4 BEGIN {
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);
13     }
14 }
15
16 use ExtUtils::testlib;
17
18 sub ok {
19     my ($id, $ok, $name) = @_;
20
21     # You have to do it this way or VMS will get confused.
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     }
28
29     return ($ok);
30 }
31
32 BEGIN {
33     $| = 1;
34     print("1..37\n");   ### Number of tests that will be run ###
35 };
36
37 use threads;
38 use threads::shared;
39 ok(1, 1, 'Loaded');
40
41 ### Start of Testing ###
42
43 my ($hobj, $aobj, $sobj) : shared;
44
45 $hobj = &share({});
46 $aobj = &share([]);
47 my $sref = \do{ my $x };
48 share($sref);
49 $sobj = $sref;
50
51 threads->create(sub {
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
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");
73
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");
78
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");
83
84              })->join;
85
86 # Test objects in parent thread
87 ok(14, ref($hobj) eq 'foo', "hash blessing does work");
88 ok(15, ref($aobj) eq 'bar', "array blessing does work");
89 ok(16, ref($sobj) eq 'baz', "scalar blessing does work");
90 ok(17, $$sobj eq '3', "scalar contents okay");
91
92 ok(18, ref($$aobj[0]) eq 'yin', "blessed hash in array");
93 ok(19, ref($$aobj[1]) eq 'yang', "blessed array in array");
94 ok(20, ref($$aobj[2]) eq 'baz', "blessed scalar in array");
95 ok(21, ${$$aobj[2]} eq '3', "blessed scalar in array contents");
96
97 ok(22, ref($$hobj{'hash'}) eq 'yin', "blessed hash in hash");
98 ok(23, ref($$hobj{'array'}) eq 'yang', "blessed array in hash");
99 ok(24, ref($$hobj{'scalar'}) eq 'baz', "blessed scalar in hash");
100 ok(25, ${$$hobj{'scalar'}} eq '3', "blessed scalar in hash contents");
101
102 threads->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();
124
125 # Test reblessing
126 ok(26, ref($hobj) eq 'oof', "hash reblessing does work");
127 ok(27, ref($aobj) eq 'rab', "array reblessing does work");
128 ok(28, ref($sobj) eq 'zab', "scalar reblessing does work");
129 ok(29, $$sobj eq 'test', "scalar contents okay");
130
131 ok(30, ref($$aobj[0]) eq 'niy', "reblessed hash in array");
132 ok(31, ref($$aobj[1]) eq 'gnay', "reblessed array in array");
133 ok(32, ref($$aobj[2]) eq 'zab', "reblessed scalar in array");
134 ok(33, ${$$aobj[2]} eq 'test', "reblessed scalar in array contents");
135
136 ok(34, ref($$hobj{'hash'}) eq 'niy', "reblessed hash in hash");
137 ok(35, ref($$hobj{'array'}) eq 'gnay', "reblessed array in hash");
138 ok(36, ref($$hobj{'scalar'}) eq 'zab', "reblessed scalar in hash");
139 ok(37, ${$$hobj{'scalar'}} eq 'test', "reblessed scalar in hash contents");
140
141 # EOF