t/op/overload.t

   1 #!./perl
   2
   3 BEGIN { unshift @INC, './lib', '../lib';
   4     require Config; import Config;
   5 }
   6
   7 package Oscalar;
   8 use overload (
   9                                 # Anonymous subroutines:
  10 '+'     =>      sub {new Oscalar $ {$_[0]}+$_[1]},
  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
  54 # All test numbers in comments are off by 1.
  55 # So much for hard-wiring them in :-)
  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 eval q[ package Oscalar; use 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 eval q[package Oscalar; use 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 eval q[ package Oscalar; use overload ('=' => sub {$main::copies++;
 157                                                    package Oscalar;
 158                                                    local $new=$ {$_[0]};
 159                                                    bless \$new } ) ];
 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
 202 eval q[package Oscalar; use overload ('+=' => sub {$ {$_[0]} += 3*$_[1];
 203                                                    $_[0] } ) ];
 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
 238 eval q[package Oscalar;
 239        use overload ('x' => sub {new Oscalar ( $_[2] ? "_.$_[1]._" x $ {$_[0]}
 240                                               : "_.${$_[0]}._" x $_[1])}) ];
 241
 242 $a=new Oscalar "yy";
 243 $a x= 3;
 244 test ($a eq "_.yy.__.yy.__.yy._"); # 87
 245
 246 eval q[package Oscalar;
 247        use overload ('.' => sub {new Oscalar ( $_[2] ?
 248                                               "_.$_[1].__.$ {$_[0]}._"
 249                                               : "_.$ {$_[0]}.__.$_[1]._")}) ];
 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
 257 eval "package Oscalar; no overload '.'";
 258
 259 test ("b${a}" eq "_.b.__.xx._"); # 89
 260 $x="1";
 261 bless \$x, Oscalar;
 262 test ("b${a}c" eq "bxxc");      # 90
 263 new Oscalar 1;
 264 test ("b${a}c" eq "bxxc");      # 91
 265
 266 # Last test is number 90.
 267 sub last {90}