lib/Math/BigInt/t/inf_nan.t

   1 #!/usr/bin/perl -w
   2
   3 # test inf/NaN handling all in one place
   4 # Thanx to Jarkko for the excellent explanations and the tables
   5
   6 use Test;
   7 use strict;
   8
   9 BEGIN
  10   {
  11   chdir 't' if -d 't';
  12   unshift @INC, '../lib';
  13   }
  14 BEGIN
  15   {
  16   $| = 1;
  17   # to locate the testing files
  18   my $location = $0; $location =~ s/inf_nan.t//i;
  19   if ($ENV{PERL_CORE})
  20     {
  21     @INC = qw(../t/lib);                # testing with the core distribution
  22     }
  23   unshift @INC, '../lib';       # for testing manually
  24   if (-d 't')
  25     {
  26     chdir 't';
  27     require File::Spec;
  28     unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
  29     }
  30   else
  31     {
  32     unshift @INC, $location;
  33     }
  34   print "# INC = @INC\n";
  35
  36                 # values    groups   oprators   classes   tests
  37   plan tests =>   7       * 6      * 5        * 4       * 2 +
  38                   7       * 6      * 2        * 4       * 1;            # bmod
  39   }
  40
  41 use Math::BigInt;
  42 use Math::BigFloat;
  43 use Math::BigInt::Subclass;
  44 use Math::BigFloat::Subclass;
  45
  46 my @classes =
  47   qw/Math::BigInt Math::BigFloat
  48      Math::BigInt::Subclass Math::BigFloat::Subclass
  49     /;
  50
  51 my (@args,$x,$y,$z);
  52
  53 # +
  54 foreach (qw/
  55   -inf:-inf:-inf
  56   -1:-inf:-inf
  57   -0:-inf:-inf
  58   0:-inf:-inf
  59   1:-inf:-inf
  60   inf:-inf:NaN
  61   NaN:-inf:NaN
  62
  63   -inf:-1:-inf
  64   -1:-1:-2
  65   -0:-1:-1
  66   0:-1:-1
  67   1:-1:0
  68   inf:-1:inf
  69   NaN:-1:NaN
  70
  71   -inf:0:-inf
  72   -1:0:-1
  73   -0:0:0
  74   0:0:0
  75   1:0:1
  76   inf:0:inf
  77   NaN:0:NaN
  78
  79   -inf:1:-inf
  80   -1:1:0
  81   -0:1:1
  82   0:1:1
  83   1:1:2
  84   inf:1:inf
  85   NaN:1:NaN
  86
  87   -inf:inf:NaN
  88   -1:inf:inf
  89   -0:inf:inf
  90   0:inf:inf
  91   1:inf:inf
  92   inf:inf:inf
  93   NaN:inf:NaN
  94
  95   -inf:NaN:NaN
  96   -1:NaN:NaN
  97   -0:NaN:NaN
  98   0:NaN:NaN
  99   1:NaN:NaN
 100   inf:NaN:NaN
 101   NaN:NaN:NaN
 102   /)
 103   {
 104   @args = split /:/,$_;
 105   for my $class (@classes)
 106     {
 107     $x = $class->new($args[0]);
 108     $y = $class->new($args[1]);
 109     $args[2] = '0' if $args[2] eq '-0';         # BigInt/Float hasn't got -0
 110     my $r = $x->badd($y);
 111
 112     print "# x $class $args[0] + $args[1] should be $args[2] but is $x\n",
 113       if !ok ($x->bstr(),$args[2]);
 114     print "# r $class $args[0] + $args[1] should be $args[2] but is $r\n",
 115       if !ok ($x->bstr(),$args[2]);
 116     }
 117   }
 118
 119 # -
 120 foreach (qw/
 121   -inf:-inf:NaN
 122   -1:-inf:inf
 123   -0:-inf:inf
 124   0:-inf:inf
 125   1:-inf:inf
 126   inf:-inf:inf
 127   NaN:-inf:NaN
 128
 129   -inf:-1:-inf
 130   -1:-1:0
 131   -0:-1:1
 132   0:-1:1
 133   1:-1:2
 134   inf:-1:inf
 135   NaN:-1:NaN
 136
 137   -inf:0:-inf
 138   -1:0:-1
 139   -0:0:-0
 140   0:0:0
 141   1:0:1
 142   inf:0:inf
 143   NaN:0:NaN
 144
 145   -inf:1:-inf
 146   -1:1:-2
 147   -0:1:-1
 148   0:1:-1
 149   1:1:0
 150   inf:1:inf
 151   NaN:1:NaN
 152
 153   -inf:inf:-inf
 154   -1:inf:-inf
 155   -0:inf:-inf
 156   0:inf:-inf
 157   1:inf:-inf
 158   inf:inf:NaN
 159   NaN:inf:NaN
 160
 161   -inf:NaN:NaN
 162   -1:NaN:NaN
 163   -0:NaN:NaN
 164   0:NaN:NaN
 165   1:NaN:NaN
 166   inf:NaN:NaN
 167   NaN:NaN:NaN
 168   /)
 169   {
 170   @args = split /:/,$_;
 171   for my $class (@classes)
 172     {
 173     $x = $class->new($args[0]);
 174     $y = $class->new($args[1]);
 175     $args[2] = '0' if $args[2] eq '-0';         # BigInt/Float hasn't got -0
 176     my $r = $x->bsub($y);
 177
 178     print "# x $class $args[0] - $args[1] should be $args[2] but is $x\n"
 179       if !ok ($x->bstr(),$args[2]);
 180     print "# r $class $args[0] - $args[1] should be $args[2] but is $r\n"
 181       if !ok ($r->bstr(),$args[2]);
 182     }
 183   }
 184
 185 # *
 186 foreach (qw/
 187   -inf:-inf:inf
 188   -1:-inf:inf
 189   -0:-inf:NaN
 190   0:-inf:NaN
 191   1:-inf:-inf
 192   inf:-inf:-inf
 193   NaN:-inf:NaN
 194
 195   -inf:-1:inf
 196   -1:-1:1
 197   -0:-1:0
 198   0:-1:-0
 199   1:-1:-1
 200   inf:-1:-inf
 201   NaN:-1:NaN
 202
 203   -inf:0:NaN
 204   -1:0:-0
 205   -0:0:-0
 206   0:0:0
 207   1:0:0
 208   inf:0:NaN
 209   NaN:0:NaN
 210
 211   -inf:1:-inf
 212   -1:1:-1
 213   -0:1:-0
 214   0:1:0
 215   1:1:1
 216   inf:1:inf
 217   NaN:1:NaN
 218
 219   -inf:inf:-inf
 220   -1:inf:-inf
 221   -0:inf:NaN
 222   0:inf:NaN
 223   1:inf:inf
 224   inf:inf:inf
 225   NaN:inf:NaN
 226
 227   -inf:NaN:NaN
 228   -1:NaN:NaN
 229   -0:NaN:NaN
 230   0:NaN:NaN
 231   1:NaN:NaN
 232   inf:NaN:NaN
 233   NaN:NaN:NaN
 234   /)
 235   {
 236   @args = split /:/,$_;
 237   for my $class (@classes)
 238     {
 239     $x = $class->new($args[0]);
 240     $y = $class->new($args[1]);
 241     $args[2] = '0' if $args[2] eq '-0';         # BigInt/Float hasn't got -0
 242     $args[2] = '0' if $args[2] eq '-0'; # BigInt hasn't got -0
 243     my $r = $x->bmul($y);
 244
 245     print "# x $class $args[0] * $args[1] should be $args[2] but is $x\n"
 246       if !ok ($x->bstr(),$args[2]);
 247     print "# r $class $args[0] * $args[1] should be $args[2] but is $r\n"
 248       if !ok ($r->bstr(),$args[2]);
 249     }
 250   }
 251
 252 # /
 253 foreach (qw/
 254   -inf:-inf:NaN
 255   -1:-inf:0
 256   -0:-inf:0
 257   0:-inf:-0
 258   1:-inf:-0
 259   inf:-inf:NaN
 260   NaN:-inf:NaN
 261
 262   -inf:-1:inf
 263   -1:-1:1
 264   -0:-1:0
 265   0:-1:-0
 266   1:-1:-1
 267   inf:-1:-inf
 268   NaN:-1:NaN
 269
 270   -inf:0:-inf
 271   -1:0:-inf
 272   -0:0:NaN
 273   0:0:NaN
 274   1:0:inf
 275   inf:0:inf
 276   NaN:0:NaN
 277
 278   -inf:1:-inf
 279   -1:1:-1
 280   -0:1:-0
 281   0:1:0
 282   1:1:1
 283   inf:1:inf
 284   NaN:1:NaN
 285
 286   -inf:inf:NaN
 287   -1:inf:-0
 288   -0:inf:-0
 289   0:inf:0
 290   1:inf:0
 291   inf:inf:NaN
 292   NaN:inf:NaN
 293
 294   -inf:NaN:NaN
 295   -1:NaN:NaN
 296   -0:NaN:NaN
 297   0:NaN:NaN
 298   1:NaN:NaN
 299   inf:NaN:NaN
 300   NaN:NaN:NaN
 301   /)
 302   {
 303   @args = split /:/,$_;
 304   for my $class (@classes)
 305     {
 306     $x = $class->new($args[0]);
 307     $y = $class->new($args[1]);
 308     $args[2] = '0' if $args[2] eq '-0';         # BigInt/Float hasn't got -0
 309
 310     my $t = $x->copy();
 311     my $tmod = $t->copy();
 312
 313     # bdiv in scalar context
 314     my $r = $x->bdiv($y);
 315     print "# x $class $args[0] / $args[1] should be $args[2] but is $x\n"
 316       if !ok ($x->bstr(),$args[2]);
 317     print "# r $class $args[0] / $args[1] should be $args[2] but is $r\n"
 318       if !ok ($r->bstr(),$args[2]);
 319
 320     # bmod and bdiv in list context
 321     my ($d,$rem) = $t->bdiv($y);
 322
 323     # bdiv in list context
 324     print "# t $class $args[0] / $args[1] should be $args[2] but is $t\n"
 325       if !ok ($t->bstr(),$args[2]);
 326     print "# d $class $args[0] / $args[1] should be $args[2] but is $d\n"
 327       if !ok ($d->bstr(),$args[2]);
 328
 329     # bmod
 330     my $m = $tmod->bmod($y);
 331
 332     # bmod() agrees with bdiv?
 333     print "# m $class $args[0] % $args[1] should be $rem but is $m\n"
 334       if !ok ($m->bstr(),$rem->bstr());
 335     # bmod() return agrees with set value?
 336     print "# o $class $args[0] % $args[1] should be $m ($rem) but is $tmod\n"
 337       if !ok ($tmod->bstr(),$m->bstr());
 338
 339     }
 340   }
 341