Commit | Line | Data |
79072805 |
1 | #!./perl |
2 | |
3 | print "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 | } |
13 | print $foo; |
14 | |
15 | $baz = "ok 3\n"; |
16 | $foo = "ok 4\n"; |
17 | { |
18 | local(*foo) = 'baz'; |
19 | print $foo; |
20 | } |
21 | print $foo; |
22 | |
23 | $foo = "ok 6\n"; |
24 | { |
25 | local(*foo); |
26 | print $foo; |
27 | $foo = "ok 5\n"; |
28 | print $foo; |
29 | } |
30 | print $foo; |
31 | |
32 | # Test fake references. |
33 | |
34 | $baz = "ok 7\n"; |
35 | $bar = 'baz'; |
36 | $foo = 'bar'; |
37 | print $$$foo; |
38 | |
39 | # Test real references. |
40 | |
41 | $FOO = \$BAR; |
42 | $BAR = \$BAZ; |
43 | $BAZ = "ok 8\n"; |
44 | print $$$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; |
53 | for $i (3,1,2,0) { |
54 | push(@{$ref[$i]}, "ok $ary[$i]\n"); |
55 | } |
56 | print @a; |
57 | print ${$ref[1]}[0]; |
58 | print @{$ref[2]}[0]; |
59 | print @{'d'}; |
60 | |
61 | # Test references to references. |
62 | |
63 | $refref = \\$x; |
64 | $x = "ok 13\n"; |
65 | print $$$refref; |
66 | |
67 | # Test nested anonymous lists. |
68 | |
69 | $ref = [[],2,[3,4,5,]]; |
70 | print scalar @$ref == 3 ? "ok 14\n" : "not ok 14\n"; |
71 | print $$ref[1] == 2 ? "ok 15\n" : "not ok 15\n"; |
72 | print ${$$ref[2]}[2] == 5 ? "ok 16\n" : "not ok 16\n"; |
73 | print scalar @{$$ref[0]} == 0 ? "ok 17\n" : "not ok 17\n"; |
74 | |
75 | print $ref->[1] == 2 ? "ok 18\n" : "not ok 18\n"; |
76 | print $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; |
82 | print $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 |
85 | |
86 | $spring[5]->[0] = 123; |
87 | $spring[5]->[1] = 456; |
88 | push(@{$spring[5]}, 789); |
89 | print 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 |
92 | |
93 | @{$spring2{"foo"}} = (1,2,3); |
94 | $spring2{"foo"}->[3] = 4; |
95 | print join(':',@{$spring2{"foo"}}) eq "1:2:3:4" ? "ok 22\n" : "not ok 22\n"; |
96 | |
97 | # Test references to subroutines. |
98 | |
99 | sub mysub { print "ok 23\n" } |
100 | $subref = \&mysub; |
101 | &$subref; |
102 | |
103 | $subrefref = \\&mysub2; |
104 | &$$subrefref("ok 24\n"); |
105 | sub mysub2 { print shift } |
106 | |
107 | # Test the ref operator. |
108 | |
109 | print ref $subref eq CODE ? "ok 25\n" : "not ok 25\n"; |
110 | print ref $ref eq ARRAY ? "ok 26\n" : "not ok 26\n"; |
111 | print ref $refref eq HASH ? "ok 27\n" : "not ok 27\n"; |
112 | |
113 | # Test anonymous hash syntax. |
114 | |
115 | $anonhash = {}; |
116 | print ref $anonhash eq HASH ? "ok 28\n" : "not ok 28\n"; |
117 | $anonhash2 = {FOO => BAR, ABC => XYZ,}; |
118 | print join('', sort values %$anonhash2) eq BARXYZ ? "ok 29\n" : "not ok 29\n"; |
119 | |
120 | # Test bless operator. |
121 | |
122 | package MYHASH; |
123 | |
124 | $object = bless $main'anonhash2; |
125 | print ref $object eq MYHASH ? "ok 30\n" : "not ok 30\n"; |
126 | print $object->{ABC} eq XYZ ? "ok 31\n" : "not ok 31\n"; |
127 | |
128 | $object2 = bless {}; |
129 | print 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 | |
135 | sub mymethod { |
136 | local($THIS, @ARGS) = @_; |
137 | die "Not a MYHASH" unless ref $THIS eq MYHASH; |
138 | print $THIS->{FOO} eq BAR ? "ok $ARGS[0]\n" : "not ok $ARGS[0]\n"; |
139 | } |
140 | |
141 | # Test automatic destructor call. |
142 | |
143 | $string = "not ok 34\n"; |
144 | $object = "foo"; |
145 | $string = "ok 34\n"; |
146 | $main'anonhash2 = "foo"; |
147 | $string = "not ok 34\n"; |
148 | |
149 | sub DESTROY { |
150 | print $string; |
151 | |
152 | # Test that the object has already been "cursed". |
153 | print ref shift eq HASH ? "ok 35\n" : "not ok 35\n"; |
154 | } |
155 | |
156 | # Now test inheritance of methods. |
157 | |
158 | package OBJ; |
159 | |
160 | @ISA = (BASEOBJ); |
161 | |
162 | $main'object = bless {FOO => foo, BAR => bar}; |
163 | |
164 | package main; |
165 | |
166 | # Test arrow-style method invocation. |
167 | |
168 | print $object->doit("BAR") eq bar ? "ok 36\n" : "not ok 36\n"; |
169 | |
170 | # Test indirect-object-style method invocation. |
171 | |
172 | $foo = doit $object "FOO"; |
173 | print $foo eq foo ? "ok 37\n" : "not ok 37\n"; |
174 | |
175 | sub BASEOBJ'doit { |
176 | local $ref = shift; |
177 | die "Not an OBJ" unless ref $ref eq OBJ; |
178 | $ref->{shift}; |
179 | } |