t/op/overload.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6 }
   7
   8 use Config;
   9
  10 package Oscalar;
  11 use overload (
  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]} :
  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
  57 # All test numbers in comments are off by 1.
  58 # So much for hard-wiring them in :-)
  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
  98 eval q[ package Oscalar; use overload ('++' => sub { $ {$_[0]}++;$_[0] } ) ];
  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
 124 eval q[package Oscalar; use overload ('++' => sub { $ {$_[0]} += 2; $_[0] } ) ];
 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
 159 eval q[ package Oscalar; use overload ('=' => sub {$main::copies++;
 160                                                    package Oscalar;
 161                                                    local $new=$ {$_[0]};
 162                                                    bless \$new } ) ];
 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
 205 eval q[package Oscalar; use overload ('+=' => sub {$ {$_[0]} += 3*$_[1];
 206                                                    $_[0] } ) ];
 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
 241 eval q[package Oscalar;
 242        use overload ('x' => sub {new Oscalar ( $_[2] ? "_.$_[1]._" x $ {$_[0]}
 243                                               : "_.${$_[0]}._" x $_[1])}) ];
 244
 245 $a=new Oscalar "yy";
 246 $a x= 3;
 247 test ($a eq "_.yy.__.yy.__.yy._"); # 87
 248
 249 eval q[package Oscalar;
 250        use overload ('.' => sub {new Oscalar ( $_[2] ?
 251                                               "_.$_[1].__.$ {$_[0]}._"
 252                                               : "_.$ {$_[0]}.__.$_[1]._")}) ];
 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
 260 eval "package Oscalar; no overload '.'";
 261
 262 test ("b${a}" eq "_.b.__.xx._"); # 89
 263 $x="1";
 264 bless \$x, Oscalar;
 265 test ("b${a}c" eq "bxxc");      # 90
 266 new Oscalar 1;
 267 test ("b${a}c" eq "bxxc");      # 91
 268
 269 # Last test is number 90.
 270 sub last {90}