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