12 # Anonymous subroutines:
13 '+' => sub {new Oscalar $ {$_[0]}+$_[1]},
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]} :
24 '%' => sub {new Oscalar
25 $_[2]? $_[1]%${$_[0]} : ${$_[0]}%$_[1]},
26 '**' => sub {new Oscalar
27 $_[2]? $_[1]**${$_[0]} : ${$_[0]}-$_[1]},
31 0+ numify) # Order of arguments unsignificant
39 sub stringify { "${$_[0]}" }
40 sub numify { 0 + "${$_[0]}" } # Not needed, additional overhead
41 # comparing to direct compilation based on
48 print "1..",&last,"\n";
56 print "not ok $test: '$_[0]' ne '$_[1]'\n";
62 print "not ok $test\n";
67 $a = new Oscalar "087";
70 # All test numbers in comments are off by 1.
71 # So much for hard-wiring them in :-) To fix this:
75 test ($b eq "087"); # 3
76 test (ref $a eq "Oscalar"); # 4
78 test ($a eq "087"); # 6
82 test (ref $c eq "Oscalar"); # 7
83 test (!($c eq $a)); # 8
84 test ($c eq "94"); # 9
88 test (ref $a eq "Oscalar"); # 10
92 test (ref $b eq "Oscalar"); # 11
93 test ( $a eq "087"); # 12
94 test ( $b eq "88"); # 13
95 test (ref $a eq "Oscalar"); # 14
100 test (ref $c eq "Oscalar"); # 15
101 test ( $a eq "087"); # 16
102 test ( $c eq "1"); # 17
103 test (ref $a eq "Oscalar"); # 18
108 test (ref $b eq "Oscalar"); # 19
109 test ( $a eq "087"); # 20
110 test ( $b eq "88"); # 21
111 test (ref $a eq "Oscalar"); # 22
113 eval q[ package Oscalar; use overload ('++' => sub { $ {$_[0]}++;$_[0] } ) ];
117 test (ref $a eq "Oscalar"); # 23
121 test (ref $b eq "Oscalar"); # 24
122 test ( $a eq "087"); # 25
123 test ( $b eq "88"); # 26
124 test (ref $a eq "Oscalar"); # 27
127 $dummy=bless \$dummy; # Now cache of method should be reloaded
133 test (ref $b eq "Oscalar"); # 28
134 test ( $a eq "087"); # 29
135 test ( $b eq "88"); # 30
136 test (ref $a eq "Oscalar"); # 31
139 eval q[package Oscalar; use overload ('++' => sub { $ {$_[0]} += 2; $_[0] } ) ];
143 test (ref $a eq "Oscalar"); # 32
147 test (ref $b eq "Oscalar"); # 33
148 test ( $a eq "087"); # 34
149 test ( $b eq "88"); # 35
150 test (ref $a eq "Oscalar"); # 36
153 $dummy=bless \$dummy; # Now cache of method should be reloaded
158 test (ref $b eq "Oscalar"); # 37
159 test ( $a eq "087"); # 38
160 test ( $b eq "90"); # 39
161 test (ref $a eq "Oscalar"); # 40
166 test (ref $b eq "Oscalar"); # 41
167 test ( $a eq "087"); # 42
168 test ( $b eq "89"); # 43
169 test (ref $a eq "Oscalar"); # 44
174 eval q[ package Oscalar; use overload ('=' => sub {$main::copies++;
176 local $new=$ {$_[0]};
181 test (ref $b eq "Oscalar"); # 46
182 test ( $a eq "087"); # 47
183 test ( $b eq "087"); # 48
184 test (ref $a eq "Oscalar"); # 49
188 test (ref $b eq "Oscalar"); # 50
189 test ( $a eq "087"); # 51
190 test ( $b eq "89"); # 52
191 test (ref $a eq "Oscalar"); # 53
192 test ($copies == 0); # 54
196 test (ref $b eq "Oscalar"); # 55
197 test ( $a eq "087"); # 56
198 test ( $b eq "90"); # 57
199 test (ref $a eq "Oscalar"); # 58
200 test ($copies == 0); # 59
205 test (ref $b eq "Oscalar"); # 60
206 test ( $a eq "087"); # 61
207 test ( $b eq "88"); # 62
208 test (ref $a eq "Oscalar"); # 63
209 test ($copies == 0); # 64
214 test (ref $b eq "Oscalar") || print ref $b,"=ref(b)\n"; # 65
215 test ( $a eq "087"); # 66
216 test ( $b eq "89"); # 67
217 test (ref $a eq "Oscalar"); # 68
218 test ($copies == 1); # 69
220 eval q[package Oscalar; use overload ('+=' => sub {$ {$_[0]} += 3*$_[1];
222 $c=new Oscalar; # Cause rehash
227 test (ref $b eq "Oscalar"); # 70
228 test ( $a eq "087"); # 71
229 test ( $b eq "90"); # 72
230 test (ref $a eq "Oscalar"); # 73
231 test ($copies == 2); # 74
235 test (ref $b eq "Oscalar"); # 75
236 test ( $b eq "360"); # 76
237 test ($copies == 2); # 77
240 test (ref $b eq "Oscalar"); # 78
241 test ( $b eq "-360"); # 79
242 test ($copies == 2); # 80
246 test (ref $b eq "Oscalar"); # 81
247 test ( $b eq "360"); # 82
248 test ($copies == 2); # 83
252 test (ref $b eq "Oscalar"); # 84
253 test ( $b eq "360"); # 85
254 test ($copies == 2); # 86
256 eval q[package Oscalar;
257 use overload ('x' => sub {new Oscalar ( $_[2] ? "_.$_[1]._" x $ {$_[0]}
258 : "_.${$_[0]}._" x $_[1])}) ];
262 test ($a eq "_.yy.__.yy.__.yy._"); # 87
264 eval q[package Oscalar;
265 use overload ('.' => sub {new Oscalar ( $_[2] ?
266 "_.$_[1].__.$ {$_[0]}._"
267 : "_.$ {$_[0]}.__.$_[1]._")}) ];
271 test ("b${a}c" eq "_._.b.__.xx._.__.c._"); # 88
273 # Check inheritance of overloading;
279 $aI = new OscalarI "$a";
280 test (ref $aI eq "OscalarI"); # 89
281 test ("$aI" eq "xx"); # 90
282 test ($aI eq "xx"); # 91
283 test ("b${aI}c" eq "_._.b.__.xx._.__.c._"); # 92
285 # Here we test blessing to a package updates hash
287 eval "package Oscalar; no overload '.'";
289 test ("b${a}" eq "_.b.__.xx._"); # 93
292 test ("b${a}c" eq "bxxc"); # 94
294 test ("b${a}c" eq "bxxc"); # 95
296 # Negative overloading:
299 test($@ =~ /no method found/); # 96
304 sub { *{"Oscalar::$AUTOLOAD"} = sub {"_!_" . shift() . "_!_"} ;
305 goto &{"Oscalar::$AUTOLOAD"}};
307 eval "package Oscalar; sub comple; use overload '~' => 'comple'";
309 $na = eval { ~$a }; # Hash was not updated
310 test($@ =~ /no method found/); # 97
314 $na = eval { ~$a }; # Hash updated
315 warn "`$na', $@" if $@;
317 test($na eq '_!_xx_!_'); # 99
321 $na = eval { ~$aI }; # Hash was not updated
322 test($@ =~ /no method found/); # 100
330 test($na eq '_!_xx_!_'); # 102
332 eval "package Oscalar; sub rshft; use overload '>>' => 'rshft'";
334 $na = eval { $aI >> 1 }; # Hash was not updated
335 test($@ =~ /no method found/); # 103
341 $na = eval { $aI >> 1 };
345 test($na eq '_!_xx_!_'); # 105
347 # warn overload::Method($a, '0+'), "\n";
348 test (overload::Method($a, '0+') eq \&Oscalar::numify); # 106
349 test (overload::Method($aI,'0+') eq \&Oscalar::numify); # 107
350 test (overload::Overloaded($aI)); # 108
351 test (!overload::Overloaded('overload')); # 109
353 test (! defined overload::Method($aI, '<<')); # 110
354 test (! defined overload::Method($a, '<')); # 111
356 test (overload::StrVal($aI) =~ /^OscalarI=SCALAR\(0x[\da-fA-F]+\)$/); # 112
357 test (overload::StrVal(\$aI) eq "@{[\$aI]}"); # 113
359 # Check overloading by methods (specified deep in the ISA tree).
363 sub Oscalar::lshft {"_<<_" . shift() . "_<<_"}
364 eval "package OscalarI; use overload '<<' => 'lshft', '|' => 'lshft'";
369 bless $aII, 'OscalarII';
370 bless \$fake, 'OscalarI'; # update the hash
371 test(($aI | 3) eq '_<<_xx_<<_'); # 114
373 test(($aII << 3) eq '_<<_087_<<_'); # 115
376 BEGIN { $int = 7; overload::constant 'integer' => sub {$int++; shift}; }
380 test($out, 1024); # 117
385 BEGIN { $q = $qr = 7;
386 overload::constant 'q' => sub {$q++; push @q, shift, ($_[1] || 'none'); shift},
387 'qr' => sub {$qr++; push @qr, shift, ($_[1] || 'none'); shift}; }
390 $out2 = "a\a$foo,\,";
394 test($out, 'foo'); # 118
395 test($out, $foo); # 119
396 test($out1, 'f\'o\\o'); # 120
397 test($out1, $foo1); # 121
398 test($out2, "a\afoo,\,"); # 122
399 test("@q", "foo q f'o\\\\o q a\\a qq ,\\, qq"); # 123
401 test("@qr", "b\\b qq .\\. qq"); # 125
405 $_ = '!<b>!foo!<-.>!';
406 BEGIN { overload::constant 'q' => sub {push @q1, shift, ($_[1] || 'none'); "_<" . (shift) . ">_"},
407 'qr' => sub {push @qr1, shift, ($_[1] || 'none'); "!<" . (shift) . ">!"}; }
410 $out2 = "a\a$foo,\,";
420 s'first part'second part';
421 s/yet another/tail here/;
425 test($out, '_<foo>_'); # 117
426 test($out1, '_<f\'o\\o>_'); # 128
427 test($out2, "_<a\a>_foo_<,\,>_"); # 129
428 test("@q1", "foo q f'o\\\\o q a\\a qq ,\\, qq oups
430 q second part q tail here s z-Z tr z-Z tr"); # 130
431 test("@qr1", "b\\b qq .\\. qq try it q first part q yet another qq"); # 131
437 test($c, "bareword"); # 135