Commit | Line | Data |
748a9306 |
1 | #!./perl |
2 | |
3 | BEGIN { unshift @INC, './lib', '../lib'; |
4 | require Config; import Config; |
5 | } |
6 | |
7 | package Oscalar; |
4633a7c4 |
8 | use overload ( |
748a9306 |
9 | # Anonymous subroutines: |
4633a7c4 |
10 | '+' => sub {new Oscalar $ {$_[0]}+$_[1]}, |
748a9306 |
11 | '-' => sub {new Oscalar |
12 | $_[2]? $_[1]-${$_[0]} : ${$_[0]}-$_[1]}, |
13 | '<=>' => sub {new Oscalar |
14 | $_[2]? $_[1]-${$_[0]} : ${$_[0]}-$_[1]}, |
15 | 'cmp' => sub {new Oscalar |
16 | $_[2]? ($_[1] cmp ${$_[0]}) : (${$_[0]} cmp $_[1])}, |
17 | '*' => sub {new Oscalar ${$_[0]}*$_[1]}, |
18 | '/' => sub {new Oscalar |
19 | $_[2]? $_[1]/${$_[0]} : |
20 | ${$_[0]}/$_[1]}, |
21 | '%' => sub {new Oscalar |
22 | $_[2]? $_[1]%${$_[0]} : ${$_[0]}%$_[1]}, |
23 | '**' => sub {new Oscalar |
24 | $_[2]? $_[1]**${$_[0]} : ${$_[0]}-$_[1]}, |
25 | |
26 | qw( |
27 | "" stringify |
28 | 0+ numify) # Order of arguments unsignificant |
29 | ); |
30 | |
31 | sub new { |
32 | my $foo = $_[1]; |
33 | bless \$foo; |
34 | } |
35 | |
36 | sub stringify { "${$_[0]}" } |
37 | sub numify { 0 + "${$_[0]}" } # Not needed, additional overhead |
38 | # comparing to direct compilation based on |
39 | # stringify |
40 | |
41 | package main; |
42 | |
43 | $test = 0; |
44 | $| = 1; |
45 | print "1..",&last,"\n"; |
46 | |
47 | sub test { |
48 | $test++; if (shift) {print "ok $test\n";1} else {print "not ok $test\n";0} |
49 | } |
50 | |
51 | $a = new Oscalar "087"; |
52 | $b= "$a"; |
53 | |
4633a7c4 |
54 | # All test numbers in comments are off by 1. |
55 | # So much for hard-wiring them in :-) |
748a9306 |
56 | test ($b eq $a); # 2 |
57 | test ($b eq "087"); # 3 |
58 | test (ref $a eq "Oscalar"); # 4 |
59 | test ($a eq $a); # 5 |
60 | test ($a eq "087"); # 6 |
61 | |
62 | $c = $a + 7; |
63 | |
64 | test (ref $c eq "Oscalar"); # 7 |
65 | test (!($c eq $a)); # 8 |
66 | test ($c eq "94"); # 9 |
67 | |
68 | $b=$a; |
69 | |
70 | test (ref $a eq "Oscalar"); # 10 |
71 | |
72 | $b++; |
73 | |
74 | test (ref $b eq "Oscalar"); # 11 |
75 | test ( $a eq "087"); # 12 |
76 | test ( $b eq "88"); # 13 |
77 | test (ref $a eq "Oscalar"); # 14 |
78 | |
79 | $c=$b; |
80 | $c-=$a; |
81 | |
82 | test (ref $c eq "Oscalar"); # 15 |
83 | test ( $a eq "087"); # 16 |
84 | test ( $c eq "1"); # 17 |
85 | test (ref $a eq "Oscalar"); # 18 |
86 | |
87 | $b=1; |
88 | $b+=$a; |
89 | |
90 | test (ref $b eq "Oscalar"); # 19 |
91 | test ( $a eq "087"); # 20 |
92 | test ( $b eq "88"); # 21 |
93 | test (ref $a eq "Oscalar"); # 22 |
94 | |
4633a7c4 |
95 | eval q[ package Oscalar; use overload ('++' => sub { $ {$_[0]}++;$_[0] } ) ]; |
748a9306 |
96 | |
97 | $b=$a; |
98 | |
99 | test (ref $a eq "Oscalar"); # 23 |
100 | |
101 | $b++; |
102 | |
103 | test (ref $b eq "Oscalar"); # 24 |
104 | test ( $a eq "087"); # 25 |
105 | test ( $b eq "88"); # 26 |
106 | test (ref $a eq "Oscalar"); # 27 |
107 | |
108 | package Oscalar; |
109 | $dummy=bless \$dummy; # Now cache of method should be reloaded |
110 | package main; |
111 | |
112 | $b=$a; |
113 | $b++; |
114 | |
115 | test (ref $b eq "Oscalar"); # 28 |
116 | test ( $a eq "087"); # 29 |
117 | test ( $b eq "88"); # 30 |
118 | test (ref $a eq "Oscalar"); # 31 |
119 | |
120 | |
4633a7c4 |
121 | eval q[package Oscalar; use overload ('++' => sub { $ {$_[0]} += 2; $_[0] } ) ]; |
748a9306 |
122 | |
123 | $b=$a; |
124 | |
125 | test (ref $a eq "Oscalar"); # 32 |
126 | |
127 | $b++; |
128 | |
129 | test (ref $b eq "Oscalar"); # 33 |
130 | test ( $a eq "087"); # 34 |
131 | test ( $b eq "88"); # 35 |
132 | test (ref $a eq "Oscalar"); # 36 |
133 | |
134 | package Oscalar; |
135 | $dummy=bless \$dummy; # Now cache of method should be reloaded |
136 | package main; |
137 | |
138 | $b++; |
139 | |
140 | test (ref $b eq "Oscalar"); # 37 |
141 | test ( $a eq "087"); # 38 |
142 | test ( $b eq "90"); # 39 |
143 | test (ref $a eq "Oscalar"); # 40 |
144 | |
145 | $b=$a; |
146 | $b++; |
147 | |
148 | test (ref $b eq "Oscalar"); # 41 |
149 | test ( $a eq "087"); # 42 |
150 | test ( $b eq "89"); # 43 |
151 | test (ref $a eq "Oscalar"); # 44 |
152 | |
153 | |
154 | test ($b? 1:0); # 45 |
155 | |
4633a7c4 |
156 | eval q[ package Oscalar; use overload ('=' => sub {$main::copies++; |
157 | package Oscalar; |
158 | local $new=$ {$_[0]}; |
159 | bless \$new } ) ]; |
748a9306 |
160 | |
161 | $b=new Oscalar "$a"; |
162 | |
163 | test (ref $b eq "Oscalar"); # 46 |
164 | test ( $a eq "087"); # 47 |
165 | test ( $b eq "087"); # 48 |
166 | test (ref $a eq "Oscalar"); # 49 |
167 | |
168 | $b++; |
169 | |
170 | test (ref $b eq "Oscalar"); # 50 |
171 | test ( $a eq "087"); # 51 |
172 | test ( $b eq "89"); # 52 |
173 | test (ref $a eq "Oscalar"); # 53 |
174 | test ($copies == 0); # 54 |
175 | |
176 | $b+=1; |
177 | |
178 | test (ref $b eq "Oscalar"); # 55 |
179 | test ( $a eq "087"); # 56 |
180 | test ( $b eq "90"); # 57 |
181 | test (ref $a eq "Oscalar"); # 58 |
182 | test ($copies == 0); # 59 |
183 | |
184 | $b=$a; |
185 | $b+=1; |
186 | |
187 | test (ref $b eq "Oscalar"); # 60 |
188 | test ( $a eq "087"); # 61 |
189 | test ( $b eq "88"); # 62 |
190 | test (ref $a eq "Oscalar"); # 63 |
191 | test ($copies == 0); # 64 |
192 | |
193 | $b=$a; |
194 | $b++; |
195 | |
196 | test (ref $b eq "Oscalar") || print ref $b,"=ref(b)\n"; # 65 |
197 | test ( $a eq "087"); # 66 |
198 | test ( $b eq "89"); # 67 |
199 | test (ref $a eq "Oscalar"); # 68 |
200 | test ($copies == 1); # 69 |
201 | |
4633a7c4 |
202 | eval q[package Oscalar; use overload ('+=' => sub {$ {$_[0]} += 3*$_[1]; |
203 | $_[0] } ) ]; |
748a9306 |
204 | $c=new Oscalar; # Cause rehash |
205 | |
206 | $b=$a; |
207 | $b+=1; |
208 | |
209 | test (ref $b eq "Oscalar"); # 70 |
210 | test ( $a eq "087"); # 71 |
211 | test ( $b eq "90"); # 72 |
212 | test (ref $a eq "Oscalar"); # 73 |
213 | test ($copies == 2); # 74 |
214 | |
215 | $b+=$b; |
216 | |
217 | test (ref $b eq "Oscalar"); # 75 |
218 | test ( $b eq "360"); # 76 |
219 | test ($copies == 2); # 77 |
220 | $b=-$b; |
221 | |
222 | test (ref $b eq "Oscalar"); # 78 |
223 | test ( $b eq "-360"); # 79 |
224 | test ($copies == 2); # 80 |
225 | |
226 | $b=abs($b); |
227 | |
228 | test (ref $b eq "Oscalar"); # 81 |
229 | test ( $b eq "360"); # 82 |
230 | test ($copies == 2); # 83 |
231 | |
232 | $b=abs($b); |
233 | |
234 | test (ref $b eq "Oscalar"); # 84 |
235 | test ( $b eq "360"); # 85 |
236 | test ($copies == 2); # 86 |
237 | |
4633a7c4 |
238 | eval q[package Oscalar; |
239 | use overload ('x' => sub {new Oscalar ( $_[2] ? "_.$_[1]._" x $ {$_[0]} |
240 | : "_.${$_[0]}._" x $_[1])}) ]; |
748a9306 |
241 | |
242 | $a=new Oscalar "yy"; |
243 | $a x= 3; |
244 | test ($a eq "_.yy.__.yy.__.yy._"); # 87 |
245 | |
4633a7c4 |
246 | eval q[package Oscalar; |
247 | use overload ('.' => sub {new Oscalar ( $_[2] ? |
248 | "_.$_[1].__.$ {$_[0]}._" |
249 | : "_.$ {$_[0]}.__.$_[1]._")}) ]; |
748a9306 |
250 | |
251 | $a=new Oscalar "xx"; |
252 | |
253 | test ("b${a}c" eq "_._.b.__.xx._.__.c._"); # 88 |
254 | |
255 | # Here we test blessing to a package updates hash |
256 | |
4633a7c4 |
257 | eval "package Oscalar; no overload '.'"; |
748a9306 |
258 | |
259 | test ("b${a}" eq "_.b.__.xx._"); # 89 |
260 | $x="1"; |
261 | bless \$x, Oscalar; |
4633a7c4 |
262 | test ("b${a}c" eq "bxxc"); # 90 |
748a9306 |
263 | new Oscalar 1; |
4633a7c4 |
264 | test ("b${a}c" eq "bxxc"); # 91 |
748a9306 |
265 | |
4633a7c4 |
266 | # Last test is number 90. |
267 | sub last {90} |