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