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