| Commit | Line | Data |
|---|
| 748a9306 |
1 | #!./perl |
| 2 | |
| 3 | BEGIN { unshift @INC, './lib', '../lib'; |
| 4 | require Config; import Config; |
| 5 | } |
| 6 | |
| 7 | package Oscalar; |
| 8 | |
| 9 | %OVERLOAD = ( |
| 10 | # Anonymous subroutines: |
| 11 | '+' => sub {new Oscalar ${$_[0]}+$_[1]}, |
| 12 | '-' => sub {new Oscalar |
| 13 | $_[2]? $_[1]-${$_[0]} : ${$_[0]}-$_[1]}, |
| 14 | '<=>' => sub {new Oscalar |
| 15 | $_[2]? $_[1]-${$_[0]} : ${$_[0]}-$_[1]}, |
| 16 | 'cmp' => sub {new Oscalar |
| 17 | $_[2]? ($_[1] cmp ${$_[0]}) : (${$_[0]} cmp $_[1])}, |
| 18 | '*' => sub {new Oscalar ${$_[0]}*$_[1]}, |
| 19 | '/' => sub {new Oscalar |
| 20 | $_[2]? $_[1]/${$_[0]} : |
| 21 | ${$_[0]}/$_[1]}, |
| 22 | '%' => sub {new Oscalar |
| 23 | $_[2]? $_[1]%${$_[0]} : ${$_[0]}%$_[1]}, |
| 24 | '**' => sub {new Oscalar |
| 25 | $_[2]? $_[1]**${$_[0]} : ${$_[0]}-$_[1]}, |
| 26 | |
| 27 | qw( |
| 28 | "" stringify |
| 29 | 0+ numify) # Order of arguments unsignificant |
| 30 | ); |
| 31 | |
| 32 | sub new { |
| 33 | my $foo = $_[1]; |
| 34 | bless \$foo; |
| 35 | } |
| 36 | |
| 37 | sub stringify { "${$_[0]}" } |
| 38 | sub numify { 0 + "${$_[0]}" } # Not needed, additional overhead |
| 39 | # comparing to direct compilation based on |
| 40 | # stringify |
| 41 | |
| 42 | package main; |
| 43 | |
| 44 | $test = 0; |
| 45 | $| = 1; |
| 46 | print "1..",&last,"\n"; |
| 47 | |
| 48 | sub test { |
| 49 | $test++; if (shift) {print "ok $test\n";1} else {print "not ok $test\n";0} |
| 50 | } |
| 51 | |
| 52 | $a = new Oscalar "087"; |
| 53 | $b= "$a"; |
| 54 | |
| 55 | test (!defined ref $b); # 1 |
| 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 | |
| 95 | $Oscalar::OVERLOAD{'++'} = sub {${$_[0]}++;$_[0]}; |
| 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 | |
| 121 | $Oscalar::OVERLOAD{'++'} = sub {${$_[0]}+=2;$_[0]}; |
| 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 | |
| 156 | $Oscalar::OVERLOAD{'='} = sub {$copies++; package Oscalar; local $new=${$_[0]};bless \$new}; |
| 157 | |
| 158 | $b=new Oscalar "$a"; |
| 159 | |
| 160 | test (ref $b eq "Oscalar"); # 46 |
| 161 | test ( $a eq "087"); # 47 |
| 162 | test ( $b eq "087"); # 48 |
| 163 | test (ref $a eq "Oscalar"); # 49 |
| 164 | |
| 165 | $b++; |
| 166 | |
| 167 | test (ref $b eq "Oscalar"); # 50 |
| 168 | test ( $a eq "087"); # 51 |
| 169 | test ( $b eq "89"); # 52 |
| 170 | test (ref $a eq "Oscalar"); # 53 |
| 171 | test ($copies == 0); # 54 |
| 172 | |
| 173 | $b+=1; |
| 174 | |
| 175 | test (ref $b eq "Oscalar"); # 55 |
| 176 | test ( $a eq "087"); # 56 |
| 177 | test ( $b eq "90"); # 57 |
| 178 | test (ref $a eq "Oscalar"); # 58 |
| 179 | test ($copies == 0); # 59 |
| 180 | |
| 181 | $b=$a; |
| 182 | $b+=1; |
| 183 | |
| 184 | test (ref $b eq "Oscalar"); # 60 |
| 185 | test ( $a eq "087"); # 61 |
| 186 | test ( $b eq "88"); # 62 |
| 187 | test (ref $a eq "Oscalar"); # 63 |
| 188 | test ($copies == 0); # 64 |
| 189 | |
| 190 | $b=$a; |
| 191 | $b++; |
| 192 | |
| 193 | test (ref $b eq "Oscalar") || print ref $b,"=ref(b)\n"; # 65 |
| 194 | test ( $a eq "087"); # 66 |
| 195 | test ( $b eq "89"); # 67 |
| 196 | test (ref $a eq "Oscalar"); # 68 |
| 197 | test ($copies == 1); # 69 |
| 198 | |
| 199 | $Oscalar::OVERLOAD{'+='} = sub {${$_[0]}+=3*$_[1];$_[0]}; |
| 200 | $c=new Oscalar; # Cause rehash |
| 201 | |
| 202 | $b=$a; |
| 203 | $b+=1; |
| 204 | |
| 205 | test (ref $b eq "Oscalar"); # 70 |
| 206 | test ( $a eq "087"); # 71 |
| 207 | test ( $b eq "90"); # 72 |
| 208 | test (ref $a eq "Oscalar"); # 73 |
| 209 | test ($copies == 2); # 74 |
| 210 | |
| 211 | $b+=$b; |
| 212 | |
| 213 | test (ref $b eq "Oscalar"); # 75 |
| 214 | test ( $b eq "360"); # 76 |
| 215 | test ($copies == 2); # 77 |
| 216 | $b=-$b; |
| 217 | |
| 218 | test (ref $b eq "Oscalar"); # 78 |
| 219 | test ( $b eq "-360"); # 79 |
| 220 | test ($copies == 2); # 80 |
| 221 | |
| 222 | $b=abs($b); |
| 223 | |
| 224 | test (ref $b eq "Oscalar"); # 81 |
| 225 | test ( $b eq "360"); # 82 |
| 226 | test ($copies == 2); # 83 |
| 227 | |
| 228 | $b=abs($b); |
| 229 | |
| 230 | test (ref $b eq "Oscalar"); # 84 |
| 231 | test ( $b eq "360"); # 85 |
| 232 | test ($copies == 2); # 86 |
| 233 | |
| 234 | $Oscalar::OVERLOAD{'x'} = sub {new Oscalar ($_[2]? "_.$_[1]._" x ${$_[0]}: |
| 235 | "_.${$_[0]}._" x $_[1])}; |
| 236 | |
| 237 | $a=new Oscalar "yy"; |
| 238 | $a x= 3; |
| 239 | test ($a eq "_.yy.__.yy.__.yy._"); # 87 |
| 240 | |
| 241 | $Oscalar::OVERLOAD{'.'} = sub {new Oscalar ($_[2]? "_.$_[1].__.${$_[0]}._": |
| 242 | "_.${$_[0]}.__.$_[1]._")}; |
| 243 | |
| 244 | $a=new Oscalar "xx"; |
| 245 | |
| 246 | test ("b${a}c" eq "_._.b.__.xx._.__.c._"); # 88 |
| 247 | |
| 248 | # Here we test blessing to a package updates hash |
| 249 | |
| 250 | delete $Oscalar::OVERLOAD{'.'}; |
| 251 | |
| 252 | test ("b${a}" eq "_.b.__.xx._"); # 89 |
| 253 | $x="1"; |
| 254 | bless \$x, Oscalar; |
| 255 | test ("b${a}c" eq "bxxc"); # 90 |
| 256 | new Oscalar 1; |
| 257 | test ("b${a}c" eq "bxxc"); # 91 |
| 258 | |
| 259 | sub last {91} |
projects / p5sagit/p5-mst-13.2.git / blame