t/pragma/overload.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6 }
   7
   8 package Oscalar;
   9 use 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, $_[0];
  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++;
  50   if (@_ > 1) {
  51     if ($_[0] eq $_[1]) {
  52       print "ok $test\n";
  53     } else {
  54       print "not ok $test: '$_[0]' ne '$_[1]'\n";
  55     }
  56   } else {
  57     if (shift) {
  58       print "ok $test\n";
  59     } else {
  60       print "not ok $test\n";
  61     }
  62   }
  63 }
  64
  65 $a = new Oscalar "087";
  66 $b= "$a";
  67
  68 # All test numbers in comments are off by 1.
  69 # So much for hard-wiring them in :-) To fix this:
  70 test(1);                        # 1
  71
  72 test ($b eq $a);                # 2
  73 test ($b eq "087");             # 3
  74 test (ref $a eq "Oscalar");     # 4
  75 test ($a eq $a);                # 5
  76 test ($a eq "087");             # 6
  77
  78 $c = $a + 7;
  79
  80 test (ref $c eq "Oscalar");     # 7
  81 test (!($c eq $a));             # 8
  82 test ($c eq "94");              # 9
  83
  84 $b=$a;
  85
  86 test (ref $a eq "Oscalar");     # 10
  87
  88 $b++;
  89
  90 test (ref $b eq "Oscalar");     # 11
  91 test ( $a eq "087");            # 12
  92 test ( $b eq "88");             # 13
  93 test (ref $a eq "Oscalar");     # 14
  94
  95 $c=$b;
  96 $c-=$a;
  97
  98 test (ref $c eq "Oscalar");     # 15
  99 test ( $a eq "087");            # 16
 100 test ( $c eq "1");              # 17
 101 test (ref $a eq "Oscalar");     # 18
 102
 103 $b=1;
 104 $b+=$a;
 105
 106 test (ref $b eq "Oscalar");     # 19
 107 test ( $a eq "087");            # 20
 108 test ( $b eq "88");             # 21
 109 test (ref $a eq "Oscalar");     # 22
 110
 111 eval q[ package Oscalar; use overload ('++' => sub { $ {$_[0]}++;$_[0] } ) ];
 112
 113 $b=$a;
 114
 115 test (ref $a eq "Oscalar");     # 23
 116
 117 $b++;
 118
 119 test (ref $b eq "Oscalar");     # 24
 120 test ( $a eq "087");            # 25
 121 test ( $b eq "88");             # 26
 122 test (ref $a eq "Oscalar");     # 27
 123
 124 package Oscalar;
 125 $dummy=bless \$dummy;           # Now cache of method should be reloaded
 126 package main;
 127
 128 $b=$a;
 129 $b++;
 130
 131 test (ref $b eq "Oscalar");     # 28
 132 test ( $a eq "087");            # 29
 133 test ( $b eq "88");             # 30
 134 test (ref $a eq "Oscalar");     # 31
 135
 136
 137 eval q[package Oscalar; use overload ('++' => sub { $ {$_[0]} += 2; $_[0] } ) ];
 138
 139 $b=$a;
 140
 141 test (ref $a eq "Oscalar");     # 32
 142
 143 $b++;
 144
 145 test (ref $b eq "Oscalar");     # 33
 146 test ( $a eq "087");            # 34
 147 test ( $b eq "88");             # 35
 148 test (ref $a eq "Oscalar");     # 36
 149
 150 package Oscalar;
 151 $dummy=bless \$dummy;           # Now cache of method should be reloaded
 152 package main;
 153
 154 $b++;
 155
 156 test (ref $b eq "Oscalar");     # 37
 157 test ( $a eq "087");            # 38
 158 test ( $b eq "90");             # 39
 159 test (ref $a eq "Oscalar");     # 40
 160
 161 $b=$a;
 162 $b++;
 163
 164 test (ref $b eq "Oscalar");     # 41
 165 test ( $a eq "087");            # 42
 166 test ( $b eq "89");             # 43
 167 test (ref $a eq "Oscalar");     # 44
 168
 169
 170 test ($b? 1:0);                 # 45
 171
 172 eval q[ package Oscalar; use overload ('=' => sub {$main::copies++;
 173                                                    package Oscalar;
 174                                                    local $new=$ {$_[0]};
 175                                                    bless \$new } ) ];
 176
 177 $b=new Oscalar "$a";
 178
 179 test (ref $b eq "Oscalar");     # 46
 180 test ( $a eq "087");            # 47
 181 test ( $b eq "087");            # 48
 182 test (ref $a eq "Oscalar");     # 49
 183
 184 $b++;
 185
 186 test (ref $b eq "Oscalar");     # 50
 187 test ( $a eq "087");            # 51
 188 test ( $b eq "89");             # 52
 189 test (ref $a eq "Oscalar");     # 53
 190 test ($copies == 0);            # 54
 191
 192 $b+=1;
 193
 194 test (ref $b eq "Oscalar");     # 55
 195 test ( $a eq "087");            # 56
 196 test ( $b eq "90");             # 57
 197 test (ref $a eq "Oscalar");     # 58
 198 test ($copies == 0);            # 59
 199
 200 $b=$a;
 201 $b+=1;
 202
 203 test (ref $b eq "Oscalar");     # 60
 204 test ( $a eq "087");            # 61
 205 test ( $b eq "88");             # 62
 206 test (ref $a eq "Oscalar");     # 63
 207 test ($copies == 0);            # 64
 208
 209 $b=$a;
 210 $b++;
 211
 212 test (ref $b eq "Oscalar") || print ref $b,"=ref(b)\n"; # 65
 213 test ( $a eq "087");            # 66
 214 test ( $b eq "89");             # 67
 215 test (ref $a eq "Oscalar");     # 68
 216 test ($copies == 1);            # 69
 217
 218 eval q[package Oscalar; use overload ('+=' => sub {$ {$_[0]} += 3*$_[1];
 219                                                    $_[0] } ) ];
 220 $c=new Oscalar;                 # Cause rehash
 221
 222 $b=$a;
 223 $b+=1;
 224
 225 test (ref $b eq "Oscalar");     # 70
 226 test ( $a eq "087");            # 71
 227 test ( $b eq "90");             # 72
 228 test (ref $a eq "Oscalar");     # 73
 229 test ($copies == 2);            # 74
 230
 231 $b+=$b;
 232
 233 test (ref $b eq "Oscalar");     # 75
 234 test ( $b eq "360");            # 76
 235 test ($copies == 2);            # 77
 236 $b=-$b;
 237
 238 test (ref $b eq "Oscalar");     # 78
 239 test ( $b eq "-360");           # 79
 240 test ($copies == 2);            # 80
 241
 242 $b=abs($b);
 243
 244 test (ref $b eq "Oscalar");     # 81
 245 test ( $b eq "360");            # 82
 246 test ($copies == 2);            # 83
 247
 248 $b=abs($b);
 249
 250 test (ref $b eq "Oscalar");     # 84
 251 test ( $b eq "360");            # 85
 252 test ($copies == 2);            # 86
 253
 254 eval q[package Oscalar;
 255        use overload ('x' => sub {new Oscalar ( $_[2] ? "_.$_[1]._" x $ {$_[0]}
 256                                               : "_.${$_[0]}._" x $_[1])}) ];
 257
 258 $a=new Oscalar "yy";
 259 $a x= 3;
 260 test ($a eq "_.yy.__.yy.__.yy._"); # 87
 261
 262 eval q[package Oscalar;
 263        use overload ('.' => sub {new Oscalar ( $_[2] ?
 264                                               "_.$_[1].__.$ {$_[0]}._"
 265                                               : "_.$ {$_[0]}.__.$_[1]._")}) ];
 266
 267 $a=new Oscalar "xx";
 268
 269 test ("b${a}c" eq "_._.b.__.xx._.__.c._"); # 88
 270
 271 # Check inheritance of overloading;
 272 {
 273   package OscalarI;
 274   @ISA = 'Oscalar';
 275 }
 276
 277 $aI = new OscalarI "$a";
 278 test (ref $aI eq "OscalarI");   # 89
 279 test ("$aI" eq "xx");           # 90
 280 test ($aI eq "xx");             # 91
 281 test ("b${aI}c" eq "_._.b.__.xx._.__.c._");             # 92
 282
 283 # Here we test blessing to a package updates hash
 284
 285 eval "package Oscalar; no overload '.'";
 286
 287 test ("b${a}" eq "_.b.__.xx._"); # 93
 288 $x="1";
 289 bless \$x, Oscalar;
 290 test ("b${a}c" eq "bxxc");      # 94
 291 new Oscalar 1;
 292 test ("b${a}c" eq "bxxc");      # 95
 293
 294 # Negative overloading:
 295
 296 $na = eval { ~$a };
 297 test($@ =~ /no method found/);  # 96
 298
 299 # Check AUTOLOADING:
 300
 301 *Oscalar::AUTOLOAD =
 302   sub { *{"Oscalar::$AUTOLOAD"} = sub {"_!_" . shift() . "_!_"} ;
 303         goto &{"Oscalar::$AUTOLOAD"}};
 304
 305 eval "package Oscalar; sub comple; use overload '~' => 'comple'";
 306
 307 $na = eval { ~$a };             # Hash was not updated
 308 test($@ =~ /no method found/);  # 97
 309
 310 bless \$x, Oscalar;
 311
 312 $na = eval { ~$a };             # Hash updated
 313 warn "`$na', $@" if $@;
 314 test !$@;                       # 98
 315 test($na eq '_!_xx_!_');        # 99
 316
 317 $na = 0;
 318
 319 $na = eval { ~$aI };            # Hash was not updated
 320 test($@ =~ /no method found/);  # 100
 321
 322 bless \$x, OscalarI;
 323
 324 $na = eval { ~$aI };
 325 print $@;
 326
 327 test !$@;                       # 101
 328 test($na eq '_!_xx_!_');        # 102
 329
 330 eval "package Oscalar; sub rshft; use overload '>>' => 'rshft'";
 331
 332 $na = eval { $aI >> 1 };        # Hash was not updated
 333 test($@ =~ /no method found/);  # 103
 334
 335 bless \$x, OscalarI;
 336
 337 $na = 0;
 338
 339 $na = eval { $aI >> 1 };
 340 print $@;
 341
 342 test !$@;                       # 104
 343 test($na eq '_!_xx_!_');        # 105
 344
 345 # warn overload::Method($a, '0+'), "\n";
 346 test (overload::Method($a, '0+') eq \&Oscalar::numify); # 106
 347 test (overload::Method($aI,'0+') eq \&Oscalar::numify); # 107
 348 test (overload::Overloaded($aI)); # 108
 349 test (!overload::Overloaded('overload')); # 109
 350
 351 test (! defined overload::Method($aI, '<<')); # 110
 352 test (! defined overload::Method($a, '<')); # 111
 353
 354 test (overload::StrVal($aI) =~ /^OscalarI=SCALAR\(0x[\da-fA-F]+\)$/); # 112
 355 test (overload::StrVal(\$aI) eq "@{[\$aI]}"); # 113
 356
 357 # Check overloading by methods (specified deep in the ISA tree).
 358 {
 359   package OscalarII;
 360   @ISA = 'OscalarI';
 361   sub Oscalar::lshft {"_<<_" . shift() . "_<<_"}
 362   eval "package OscalarI; use overload '<<' => 'lshft', '|' => 'lshft'";
 363 }
 364
 365 $aaII = "087";
 366 $aII = \$aaII;
 367 bless $aII, 'OscalarII';
 368 bless \$fake, 'OscalarI';               # update the hash
 369 test(($aI | 3) eq '_<<_xx_<<_');        # 114
 370 # warn $aII << 3;
 371 test(($aII << 3) eq '_<<_087_<<_');     # 115
 372
 373 {
 374   BEGIN { $int = 7; overload::constant 'integer' => sub {$int++; shift}; }
 375   $out = 2**10;
 376 }
 377 test($int, 9);          # 116
 378 test($out, 1024);               # 117
 379
 380 $foo = 'foo';
 381 $foo1 = 'f\'o\\o';
 382 {
 383   BEGIN { $q = $qr = 7;
 384           overload::constant 'q' => sub {$q++; push @q, shift, ($_[1] || 'none'); shift},
 385                              'qr' => sub {$qr++; push @qr, shift, ($_[1] || 'none'); shift}; }
 386   $out = 'foo';
 387   $out1 = 'f\'o\\o';
 388   $out2 = "a\a$foo,\,";
 389   /b\b$foo.\./;
 390 }
 391
 392 test($out, 'foo');              # 118
 393 test($out, $foo);               # 119
 394 test($out1, 'f\'o\\o');         # 120
 395 test($out1, $foo1);             # 121
 396 test($out2, "a\afoo,\,");       # 122
 397 test("@q", "foo q f'o\\\\o q a\\a qq ,\\, qq"); # 123
 398 test($q, 11);                   # 124
 399 test("@qr", "b\\b qq .\\. qq"); # 125
 400 test($qr, 9);                   # 126
 401
 402 {
 403   $_ = '!<b>!foo!<-.>!';
 404   BEGIN { overload::constant 'q' => sub {push @q1, shift, ($_[1] || 'none'); "_<" . (shift) . ">_"},
 405                              'qr' => sub {push @qr1, shift, ($_[1] || 'none'); "!<" . (shift) . ">!"}; }
 406   $out = 'foo';
 407   $out1 = 'f\'o\\o';
 408   $out2 = "a\a$foo,\,";
 409   $res = /b\b$foo.\./;
 410   $a = <<EOF;
 411 oups
 412 EOF
 413   $b = <<'EOF';
 414 oups1
 415 EOF
 416   $c = bareword;
 417   m'try it';
 418   s'first part'second part';
 419   s/yet another/tail here/;
 420   tr/z-Z/z-Z/;
 421 }
 422
 423 test($out, '_<foo>_');          # 117
 424 test($out1, '_<f\'o\\o>_');             # 128
 425 test($out2, "_<a\a>_foo_<,\,>_");       # 129
 426 test("@q1", "foo q f'o\\\\o q a\\a qq ,\\, qq oups
 427  qq oups1
 428  q second part q tail here s z-Z tr z-Z tr");   # 130
 429 test("@qr1", "b\\b qq .\\. qq try it q first part q yet another qq");   # 131
 430 test($res, 1);                  # 132
 431 test($a, "_<oups
 432 >_");   # 133
 433 test($b, "_<oups1
 434 >_");   # 134
 435 test($c, "bareword");   # 135
 436
 437 {
 438   package symbolic;             # Primitive symbolic calculator
 439   use overload nomethod => \&wrap, '""' => \&str, '0+' => \&num,
 440       '=' => \&cpy, '++' => \&inc, '--' => \&dec;
 441
 442   sub new { shift; bless ['n', @_] }
 443   sub cpy {
 444     my $self = shift;
 445     bless [@$self], ref $self;
 446   }
 447   sub inc { $_[0] = bless ['++', $_[0], 1]; }
 448   sub dec { $_[0] = bless ['--', $_[0], 1]; }
 449   sub wrap {
 450     my ($obj, $other, $inv, $meth) = @_;
 451     if ($meth eq '++' or $meth eq '--') {
 452       @$obj = ($meth, (bless [@$obj]), 1); # Avoid circular reference
 453       return $obj;
 454     }
 455     ($obj, $other) = ($other, $obj) if $inv;
 456     bless [$meth, $obj, $other];
 457   }
 458   sub str {
 459     my ($meth, $a, $b) = @{+shift};
 460     $a = 'u' unless defined $a;
 461     if (defined $b) {
 462       "[$meth $a $b]";
 463     } else {
 464       "[$meth $a]";
 465     }
 466   }
 467   my %subr = ( 'n' => sub {$_[0]} );
 468   foreach my $op (split " ", $overload::ops{with_assign}) {
 469     $subr{$op} = $subr{"$op="} = eval "sub {shift() $op shift()}";
 470   }
 471   my @bins = qw(binary 3way_comparison num_comparison str_comparison);
 472   foreach my $op (split " ", "@overload::ops{ @bins }") {
 473     $subr{$op} = eval "sub {shift() $op shift()}";
 474   }
 475   foreach my $op (split " ", "@overload::ops{qw(unary func)}") {
 476     $subr{$op} = eval "sub {$op shift()}";
 477   }
 478   $subr{'++'} = $subr{'+'};
 479   $subr{'--'} = $subr{'-'};
 480
 481   sub num {
 482     my ($meth, $a, $b) = @{+shift};
 483     my $subr = $subr{$meth}
 484       or die "Do not know how to ($meth) in symbolic";
 485     $a = $a->num if ref $a eq __PACKAGE__;
 486     $b = $b->num if ref $b eq __PACKAGE__;
 487     $subr->($a,$b);
 488   }
 489   sub TIESCALAR { my $pack = shift; $pack->new(@_) }
 490   sub FETCH { shift }
 491   sub nop {  }          # Around a bug
 492   sub vars { my $p = shift; tie($_, $p), $_->nop foreach @_; }
 493   sub STORE {
 494     my $obj = shift;
 495     $#$obj = 1;
 496     @$obj->[0,1] = ('=', shift);
 497   }
 498 }
 499
 500 {
 501   my $foo = new symbolic 11;
 502   my $baz = $foo++;
 503   test( (sprintf "%d", $foo), '12');
 504   test( (sprintf "%d", $baz), '11');
 505   my $bar = $foo;
 506   $baz = ++$foo;
 507   test( (sprintf "%d", $foo), '13');
 508   test( (sprintf "%d", $bar), '12');
 509   test( (sprintf "%d", $baz), '13');
 510   my $ban = $foo;
 511   $baz = ($foo += 1);
 512   test( (sprintf "%d", $foo), '14');
 513   test( (sprintf "%d", $bar), '12');
 514   test( (sprintf "%d", $baz), '14');
 515   test( (sprintf "%d", $ban), '13');
 516   $baz = 0;
 517   $baz = $foo++;
 518   test( (sprintf "%d", $foo), '15');
 519   test( (sprintf "%d", $baz), '14');
 520   test( "$foo", '[++ [+= [++ [++ [n 11] 1] 1] 1] 1]');
 521 }
 522
 523 {
 524   my $iter = new symbolic 2;
 525   my $side = new symbolic 1;
 526   my $cnt = $iter;
 527
 528   while ($cnt) {
 529     $cnt = $cnt - 1;            # The "simple" way
 530     $side = (sqrt(1 + $side**2) - 1)/$side;
 531   }
 532   my $pi = $side*(2**($iter+2));
 533   test "$side", '[/ [- [sqrt [+ 1 [** [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]] 2]]] 1] [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]]]';
 534   test( (sprintf "%f", $pi), '3.182598');
 535 }
 536
 537 {
 538   my $iter = new symbolic 2;
 539   my $side = new symbolic 1;
 540   my $cnt = $iter;
 541
 542   while ($cnt--) {
 543     $side = (sqrt(1 + $side**2) - 1)/$side;
 544   }
 545   my $pi = $side*(2**($iter+2));
 546   test "$side", '[/ [- [sqrt [+ 1 [** [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]] 2]]] 1] [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]]]';
 547   test( (sprintf "%f", $pi), '3.182598');
 548 }
 549
 550 {
 551   my ($a, $b);
 552   symbolic->vars($a, $b);
 553   my $c = sqrt($a**2 + $b**2);
 554   $a = 3; $b = 4;
 555   test( (sprintf "%d", $c), '5');
 556   $a = 12; $b = 5;
 557   test( (sprintf "%d", $c), '13');
 558 }
 559
 560 {
 561   package symbolic1;            # Primitive symbolic calculator
 562   # Mutator inc/dec
 563   use overload nomethod => \&wrap, '""' => \&str, '0+' => \&num, '=' => \&cpy;
 564
 565   sub new { shift; bless ['n', @_] }
 566   sub cpy {
 567     my $self = shift;
 568     bless [@$self], ref $self;
 569   }
 570   sub wrap {
 571     my ($obj, $other, $inv, $meth) = @_;
 572     if ($meth eq '++' or $meth eq '--') {
 573       @$obj = ($meth, (bless [@$obj]), 1); # Avoid circular reference
 574       return $obj;
 575     }
 576     ($obj, $other) = ($other, $obj) if $inv;
 577     bless [$meth, $obj, $other];
 578   }
 579   sub str {
 580     my ($meth, $a, $b) = @{+shift};
 581     $a = 'u' unless defined $a;
 582     if (defined $b) {
 583       "[$meth $a $b]";
 584     } else {
 585       "[$meth $a]";
 586     }
 587   }
 588   my %subr = ( 'n' => sub {$_[0]} );
 589   foreach my $op (split " ", $overload::ops{with_assign}) {
 590     $subr{$op} = $subr{"$op="} = eval "sub {shift() $op shift()}";
 591   }
 592   my @bins = qw(binary 3way_comparison num_comparison str_comparison);
 593   foreach my $op (split " ", "@overload::ops{ @bins }") {
 594     $subr{$op} = eval "sub {shift() $op shift()}";
 595   }
 596   foreach my $op (split " ", "@overload::ops{qw(unary func)}") {
 597     $subr{$op} = eval "sub {$op shift()}";
 598   }
 599   $subr{'++'} = $subr{'+'};
 600   $subr{'--'} = $subr{'-'};
 601
 602   sub num {
 603     my ($meth, $a, $b) = @{+shift};
 604     my $subr = $subr{$meth}
 605       or die "Do not know how to ($meth) in symbolic";
 606     $a = $a->num if ref $a eq __PACKAGE__;
 607     $b = $b->num if ref $b eq __PACKAGE__;
 608     $subr->($a,$b);
 609   }
 610   sub TIESCALAR { my $pack = shift; $pack->new(@_) }
 611   sub FETCH { shift }
 612   sub nop {  }          # Around a bug
 613   sub vars { my $p = shift; tie($_, $p), $_->nop foreach @_; }
 614   sub STORE {
 615     my $obj = shift;
 616     $#$obj = 1;
 617     @$obj->[0,1] = ('=', shift);
 618   }
 619 }
 620
 621 {
 622   my $foo = new symbolic1 11;
 623   my $baz = $foo++;
 624   test( (sprintf "%d", $foo), '12');
 625   test( (sprintf "%d", $baz), '11');
 626   my $bar = $foo;
 627   $baz = ++$foo;
 628   test( (sprintf "%d", $foo), '13');
 629   test( (sprintf "%d", $bar), '12');
 630   test( (sprintf "%d", $baz), '13');
 631   my $ban = $foo;
 632   $baz = ($foo += 1);
 633   test( (sprintf "%d", $foo), '14');
 634   test( (sprintf "%d", $bar), '12');
 635   test( (sprintf "%d", $baz), '14');
 636   test( (sprintf "%d", $ban), '13');
 637   $baz = 0;
 638   $baz = $foo++;
 639   test( (sprintf "%d", $foo), '15');
 640   test( (sprintf "%d", $baz), '14');
 641   test( "$foo", '[++ [+= [++ [++ [n 11] 1] 1] 1] 1]');
 642 }
 643
 644 {
 645   my $iter = new symbolic1 2;
 646   my $side = new symbolic1 1;
 647   my $cnt = $iter;
 648
 649   while ($cnt) {
 650     $cnt = $cnt - 1;            # The "simple" way
 651     $side = (sqrt(1 + $side**2) - 1)/$side;
 652   }
 653   my $pi = $side*(2**($iter+2));
 654   test "$side", '[/ [- [sqrt [+ 1 [** [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]] 2]]] 1] [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]]]';
 655   test( (sprintf "%f", $pi), '3.182598');
 656 }
 657
 658 {
 659   my $iter = new symbolic1 2;
 660   my $side = new symbolic1 1;
 661   my $cnt = $iter;
 662
 663   while ($cnt--) {
 664     $side = (sqrt(1 + $side**2) - 1)/$side;
 665   }
 666   my $pi = $side*(2**($iter+2));
 667   test "$side", '[/ [- [sqrt [+ 1 [** [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]] 2]]] 1] [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]]]';
 668   test( (sprintf "%f", $pi), '3.182598');
 669 }
 670
 671 {
 672   my ($a, $b);
 673   symbolic1->vars($a, $b);
 674   my $c = sqrt($a**2 + $b**2);
 675   $a = 3; $b = 4;
 676   test( (sprintf "%d", $c), '5');
 677   $a = 12; $b = 5;
 678   test( (sprintf "%d", $c), '13');
 679 }
 680
 681 {
 682   package two_face;             # Scalars with separate string and
 683                                 # numeric values.
 684   sub new { my $p = shift; bless [@_], $p }
 685   use overload '""' => \&str, '0+' => \&num, fallback => 1;
 686   sub num {shift->[1]}
 687   sub str {shift->[0]}
 688 }
 689
 690 {
 691   my $seven = new two_face ("vii", 7);
 692   test( (sprintf "seven=$seven, seven=%d, eight=%d", $seven, $seven+1),
 693         'seven=vii, seven=7, eight=8');
 694   test( scalar ($seven =~ /i/), '1')
 695 }
 696
 697 # Last test is:
 698 sub last {173}