t/op/overload.t

   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}