This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl 5.0 alpha 5
[perl5.git] / t / op / ref.t
CommitLineData
79072805
LW
1#!./perl
2
3print "1..37\n";
4
5# Test glob operations.
6
7$bar = "ok 1\n";
8$foo = "ok 2\n";
9{
10 local(*foo) = *bar;
11 print $foo;
12}
13print $foo;
14
15$baz = "ok 3\n";
16$foo = "ok 4\n";
17{
18 local(*foo) = 'baz';
19 print $foo;
20}
21print $foo;
22
23$foo = "ok 6\n";
24{
25 local(*foo);
26 print $foo;
27 $foo = "ok 5\n";
28 print $foo;
29}
30print $foo;
31
32# Test fake references.
33
34$baz = "ok 7\n";
35$bar = 'baz';
36$foo = 'bar';
37print $$$foo;
38
39# Test real references.
40
41$FOO = \$BAR;
42$BAR = \$BAZ;
43$BAZ = "ok 8\n";
44print $$$FOO;
45
46# Test references to real arrays.
47
48@ary = (9,10,11,12);
49$ref[0] = \@a;
50$ref[1] = \@b;
51$ref[2] = \@c;
52$ref[3] = \@d;
53for $i (3,1,2,0) {
54 push(@{$ref[$i]}, "ok $ary[$i]\n");
55}
56print @a;
57print ${$ref[1]}[0];
58print @{$ref[2]}[0];
59print @{'d'};
60
61# Test references to references.
62
63$refref = \\$x;
64$x = "ok 13\n";
65print $$$refref;
66
67# Test nested anonymous lists.
68
69$ref = [[],2,[3,4,5,]];
70print scalar @$ref == 3 ? "ok 14\n" : "not ok 14\n";
71print $$ref[1] == 2 ? "ok 15\n" : "not ok 15\n";
72print ${$$ref[2]}[2] == 5 ? "ok 16\n" : "not ok 16\n";
73print scalar @{$$ref[0]} == 0 ? "ok 17\n" : "not ok 17\n";
74
75print $ref->[1] == 2 ? "ok 18\n" : "not ok 18\n";
76print $ref->[2]->[0] == 3 ? "ok 19\n" : "not ok 18\n";
77
78# Test references to hashes of references.
79
80$refref = \%whatever;
81$refref->{"key"} = $ref;
82print $refref->{"key"}->[2]->[0] == 3 ? "ok 20\n" : "not ok 20\n";
83
93a17b20 84# Test to see if anonymous subarrays spring into existence.
79072805
LW
85
86$spring[5]->[0] = 123;
87$spring[5]->[1] = 456;
88push(@{$spring[5]}, 789);
89print join(':',@{$spring[5]}) eq "123:456:789" ? "ok 21\n" : "not ok 21\n";
90
93a17b20 91# Test to see if anonymous subhashes spring into existence.
79072805
LW
92
93@{$spring2{"foo"}} = (1,2,3);
94$spring2{"foo"}->[3] = 4;
95print join(':',@{$spring2{"foo"}}) eq "1:2:3:4" ? "ok 22\n" : "not ok 22\n";
96
97# Test references to subroutines.
98
99sub mysub { print "ok 23\n" }
100$subref = \&mysub;
101&$subref;
102
103$subrefref = \\&mysub2;
104&$$subrefref("ok 24\n");
105sub mysub2 { print shift }
106
107# Test the ref operator.
108
109print ref $subref eq CODE ? "ok 25\n" : "not ok 25\n";
110print ref $ref eq ARRAY ? "ok 26\n" : "not ok 26\n";
111print ref $refref eq HASH ? "ok 27\n" : "not ok 27\n";
112
113# Test anonymous hash syntax.
114
115$anonhash = {};
116print ref $anonhash eq HASH ? "ok 28\n" : "not ok 28\n";
117$anonhash2 = {FOO => BAR, ABC => XYZ,};
118print join('', sort values %$anonhash2) eq BARXYZ ? "ok 29\n" : "not ok 29\n";
119
120# Test bless operator.
121
122package MYHASH;
123
124$object = bless $main'anonhash2;
125print ref $object eq MYHASH ? "ok 30\n" : "not ok 30\n";
126print $object->{ABC} eq XYZ ? "ok 31\n" : "not ok 31\n";
127
128$object2 = bless {};
129print ref $object2 eq MYHASH ? "ok 32\n" : "not ok 32\n";
130
131# Test ordinary call on object method.
132
133&mymethod($object,33);
134
135sub mymethod {
136 local($THIS, @ARGS) = @_;
ed6116ce
LW
137 die 'Got a "' . ref($THIS). '" instead of a MYHASH'
138 unless ref $THIS eq MYHASH;
79072805
LW
139 print $THIS->{FOO} eq BAR ? "ok $ARGS[0]\n" : "not ok $ARGS[0]\n";
140}
141
142# Test automatic destructor call.
143
144$string = "not ok 34\n";
145$object = "foo";
146$string = "ok 34\n";
147$main'anonhash2 = "foo";
148$string = "not ok 34\n";
149
ed6116ce 150DESTROY {
79072805
LW
151 print $string;
152
153 # Test that the object has already been "cursed".
154 print ref shift eq HASH ? "ok 35\n" : "not ok 35\n";
155}
156
157# Now test inheritance of methods.
158
159package OBJ;
160
161@ISA = (BASEOBJ);
162
163$main'object = bless {FOO => foo, BAR => bar};
164
165package main;
166
167# Test arrow-style method invocation.
168
169print $object->doit("BAR") eq bar ? "ok 36\n" : "not ok 36\n";
170
171# Test indirect-object-style method invocation.
172
173$foo = doit $object "FOO";
174print $foo eq foo ? "ok 37\n" : "not ok 37\n";
175
176sub BASEOBJ'doit {
177 local $ref = shift;
178 die "Not an OBJ" unless ref $ref eq OBJ;
179 $ref->{shift};
180}