[p5sagit/p5-mst-13.2.git] / cpan / Math-BigInt / t / inf_nan.t

#!/usr/bin/perl -w

# test inf/NaN handling all in one place
# Thanx to Jarkko for the excellent explanations and the tables

use Test::More;
use strict;

BEGIN
  {
  $| = 1;	
  # to locate the testing files
  my $location = $0; $location =~ s/inf_nan.t//i;
  if ($ENV{PERL_CORE})
    {
    @INC = qw(../t/lib);                # testing with the core distribution
    }
  unshift @INC, '../lib';       # for testing manually
  if (-d 't')
    {
    chdir 't';
    require File::Spec;
    unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
    }
  else
    {
    unshift @INC, $location;
    }
  print "# INC = @INC\n";

	        # values    groups   operators   classes   tests 
  plan tests =>   7       * 6      * 5         * 4       * 2 +
                  7       * 6      * 2         * 4       * 1	  # bmod
;
# see bottom:		+ 4 * 10;					  # 4 classes * 10 NaN == NaN tests
  }

use Math::BigInt;
use Math::BigFloat;
use Math::BigInt::Subclass;
use Math::BigFloat::Subclass;

my @classes = 
  qw/Math::BigInt Math::BigFloat
     Math::BigInt::Subclass Math::BigFloat::Subclass
    /;

my (@args,$x,$y,$z);

# +
foreach (qw/
  -inf:-inf:-inf
  -1:-inf:-inf
  -0:-inf:-inf
  0:-inf:-inf
  1:-inf:-inf
  inf:-inf:NaN
  NaN:-inf:NaN

  -inf:-1:-inf
  -1:-1:-2
  -0:-1:-1
  0:-1:-1
  1:-1:0
  inf:-1:inf
  NaN:-1:NaN

  -inf:0:-inf
  -1:0:-1
  -0:0:0
  0:0:0
  1:0:1
  inf:0:inf
  NaN:0:NaN

  -inf:1:-inf
  -1:1:0
  -0:1:1
  0:1:1
  1:1:2
  inf:1:inf
  NaN:1:NaN

  -inf:inf:NaN
  -1:inf:inf
  -0:inf:inf
  0:inf:inf
  1:inf:inf
  inf:inf:inf
  NaN:inf:NaN

  -inf:NaN:NaN
  -1:NaN:NaN
  -0:NaN:NaN
  0:NaN:NaN
  1:NaN:NaN
  inf:NaN:NaN
  NaN:NaN:NaN
  /)
  {
  @args = split /:/,$_;
  for my $class (@classes)
    {
    $x = $class->new($args[0]);
    $y = $class->new($args[1]);
    $args[2] = '0' if $args[2] eq '-0';		# BigInt/Float hasn't got -0
    my $r = $x->badd($y);

    is($x->bstr(),$args[2],"x $class $args[0] + $args[1]");
    is($x->bstr(),$args[2],"r $class $args[0] + $args[1]");
    }
  }

# -
foreach (qw/
  -inf:-inf:NaN
  -1:-inf:inf
  -0:-inf:inf
  0:-inf:inf
  1:-inf:inf
  inf:-inf:inf
  NaN:-inf:NaN

  -inf:-1:-inf
  -1:-1:0
  -0:-1:1
  0:-1:1
  1:-1:2
  inf:-1:inf
  NaN:-1:NaN

  -inf:0:-inf
  -1:0:-1
  -0:0:-0
  0:0:0
  1:0:1
  inf:0:inf
  NaN:0:NaN

  -inf:1:-inf
  -1:1:-2
  -0:1:-1
  0:1:-1
  1:1:0
  inf:1:inf
  NaN:1:NaN

  -inf:inf:-inf
  -1:inf:-inf
  -0:inf:-inf
  0:inf:-inf
  1:inf:-inf
  inf:inf:NaN
  NaN:inf:NaN

  -inf:NaN:NaN
  -1:NaN:NaN
  -0:NaN:NaN
  0:NaN:NaN
  1:NaN:NaN
  inf:NaN:NaN
  NaN:NaN:NaN
  /)
  {
  @args = split /:/,$_;
  for my $class (@classes)
    {
    $x = $class->new($args[0]);
    $y = $class->new($args[1]);
    $args[2] = '0' if $args[2] eq '-0';		# BigInt/Float hasn't got -0
    my $r = $x->bsub($y);

    is($x->bstr(),$args[2],"x $class $args[0] - $args[1]");
    is($r->bstr(),$args[2],"r $class $args[0] - $args[1]");
    }
  }

# *
foreach (qw/
  -inf:-inf:inf
  -1:-inf:inf
  -0:-inf:NaN
  0:-inf:NaN
  1:-inf:-inf
  inf:-inf:-inf
  NaN:-inf:NaN

  -inf:-1:inf
  -1:-1:1
  -0:-1:0
  0:-1:-0
  1:-1:-1
  inf:-1:-inf
  NaN:-1:NaN

  -inf:0:NaN
  -1:0:-0
  -0:0:-0
  0:0:0
  1:0:0
  inf:0:NaN
  NaN:0:NaN

  -inf:1:-inf
  -1:1:-1
  -0:1:-0
  0:1:0
  1:1:1
  inf:1:inf
  NaN:1:NaN

  -inf:inf:-inf
  -1:inf:-inf
  -0:inf:NaN
  0:inf:NaN
  1:inf:inf
  inf:inf:inf
  NaN:inf:NaN

  -inf:NaN:NaN
  -1:NaN:NaN
  -0:NaN:NaN
  0:NaN:NaN
  1:NaN:NaN
  inf:NaN:NaN
  NaN:NaN:NaN
  /)
  {
  @args = split /:/,$_;
  for my $class (@classes)
    {
    $x = $class->new($args[0]);
    $y = $class->new($args[1]);
    $args[2] = '0' if $args[2] eq '-0';		# BigInt/Float hasn't got -0
    $args[2] = '0' if $args[2] eq '-0';	# BigInt hasn't got -0
    my $r = $x->bmul($y);

    is($x->bstr(),$args[2],"x $class $args[0] * $args[1]");
    is($r->bstr(),$args[2],"r $class $args[0] * $args[1]");
    }
  }

# /
foreach (qw/
  -inf:-inf:NaN
  -1:-inf:0
  -0:-inf:0
  0:-inf:-0
  1:-inf:-0
  inf:-inf:NaN
  NaN:-inf:NaN

  -inf:-1:inf
  -1:-1:1
  -0:-1:0
  0:-1:-0
  1:-1:-1
  inf:-1:-inf
  NaN:-1:NaN

  -inf:0:-inf
  -1:0:-inf
  -0:0:NaN
  0:0:NaN
  1:0:inf
  inf:0:inf
  NaN:0:NaN

  -inf:1:-inf
  -1:1:-1
  -0:1:-0
  0:1:0
  1:1:1
  inf:1:inf
  NaN:1:NaN

  -inf:inf:NaN
  -1:inf:-0
  -0:inf:-0
  0:inf:0
  1:inf:0
  inf:inf:NaN
  NaN:inf:NaN

  -inf:NaN:NaN
  -1:NaN:NaN
  -0:NaN:NaN
  0:NaN:NaN
  1:NaN:NaN
  inf:NaN:NaN
  NaN:NaN:NaN
  /)
  {
  @args = split /:/,$_;
  for my $class (@classes)
    {
    $x = $class->new($args[0]);
    $y = $class->new($args[1]);
    $args[2] = '0' if $args[2] eq '-0';		# BigInt/Float hasn't got -0

    my $t = $x->copy();
    my $tmod = $t->copy();

    # bdiv in scalar context
    my $r = $x->bdiv($y);
    is($x->bstr(),$args[2],"x $class $args[0] / $args[1]");
    is($r->bstr(),$args[2],"r $class $args[0] / $args[1]");

    # bmod and bdiv in list context
    my ($d,$rem) = $t->bdiv($y);

    # bdiv in list context
    is($t->bstr(),$args[2],"t $class $args[0] / $args[1]");
    is($d->bstr(),$args[2],"d $class $args[0] / $args[1]");
    
    # bmod
    my $m = $tmod->bmod($y);

    # bmod() agrees with bdiv?
    is($m->bstr(),$rem->bstr(),"m $class $args[0] % $args[1]");
    # bmod() return agrees with set value?
    is($tmod->bstr(),$m->bstr(),"o $class $args[0] % $args[1]");

    }
  }

#############################################################################
# overloaded comparisations

# these are disabled for now, since Perl itself can't seem to make up it's
# mind what NaN actually is, see [perl #33106].

#
#foreach my $c (@classes)
#  {
#  my $x = $c->bnan();
#  my $y = $c->bnan();		# test with two different objects, too
#  my $a = $c->bzero();
#
#  is ($x == $y, undef, 'NaN == NaN: undef');
#  is ($x != $y, 1, 'NaN != NaN: 1');
#  
#  is ($x == $x, undef, 'NaN == NaN: undef');
#  is ($x != $x, 1, 'NaN != NaN: 1');
#  
#  is ($a != $x, 1, '0 != NaN: 1');
#  is ($a == $x, undef, '0 == NaN: undef');
#
#  is ($a < $x, undef, '0 < NaN: undef');
#  is ($a <= $x, undef, '0 <= NaN: undef');
#  is ($a >= $x, undef, '0 >= NaN: undef');
#  is ($a > $x, undef, '0 > NaN: undef');
#  }

# All done.
Commit	Line	Data
b3abae2a	1	#!/usr/bin/perl -w
b3abae2a	2
13a12e00	3	# test inf/NaN handling all in one place
	4	# Thanx to Jarkko for the excellent explanations and the tables
	5
b68b7ab1	6	use Test::More;
b3abae2a	7	use strict;
	8
	9	BEGIN
	10	{
f9a08e12	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
990fb837	31	# values groups operators classes tests
990fb837	32	plan tests => 7 * 6 * 5 * 4 * 2 +
b68b7ab1	33	7 * 6 * 2 * 4 * 1 # bmod
	34	;
	35	# see bottom: + 4 * 10; # 4 classes * 10 NaN == NaN tests
f9a08e12	36	}
b3abae2a	37
b3abae2a	38	use Math::BigInt;
13a12e00	39	use Math::BigFloat;
f9a08e12	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	/;
b3abae2a	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 /:/,$_;
f9a08e12	102	for my $class (@classes)
13a12e00	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
f9a08e12	107	my $r = $x->badd($y);
f9a08e12	108
b68b7ab1	109	is($x->bstr(),$args[2],"x $class $args[0] + $args[1]");
b68b7ab1	110	is($x->bstr(),$args[2],"r $class $args[0] + $args[1]");
13a12e00	111	}
b3abae2a	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 /:/,$_;
f9a08e12	166	for my $class (@classes)
13a12e00	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
f9a08e12	171	my $r = $x->bsub($y);
f9a08e12	172
b68b7ab1	173	is($x->bstr(),$args[2],"x $class $args[0] - $args[1]");
b68b7ab1	174	is($r->bstr(),$args[2],"r $class $args[0] - $args[1]");
13a12e00	175	}
b3abae2a	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 /:/,$_;
f9a08e12	230	for my $class (@classes)
13a12e00	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
f9a08e12	236	my $r = $x->bmul($y);
f9a08e12	237
b68b7ab1	238	is($x->bstr(),$args[2],"x $class $args[0] * $args[1]");
b68b7ab1	239	is($r->bstr(),$args[2],"r $class $args[0] * $args[1]");
13a12e00	240	}
b3abae2a	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 /:/,$_;
f9a08e12	295	for my $class (@classes)
13a12e00	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
f9a08e12	300
	301	my $t = $x->copy();
	302	my $tmod = $t->copy();
	303
	304	# bdiv in scalar context
	305	my $r = $x->bdiv($y);
b68b7ab1	306	is($x->bstr(),$args[2],"x $class $args[0] / $args[1]");
b68b7ab1	307	is($r->bstr(),$args[2],"r $class $args[0] / $args[1]");
f9a08e12	308
	309	# bmod and bdiv in list context
	310	my ($d,$rem) = $t->bdiv($y);
	311
	312	# bdiv in list context
b68b7ab1	313	is($t->bstr(),$args[2],"t $class $args[0] / $args[1]");
b68b7ab1	314	is($d->bstr(),$args[2],"d $class $args[0] / $args[1]");
f9a08e12	315
	316	# bmod
	317	my $m = $tmod->bmod($y);
	318
	319	# bmod() agrees with bdiv?
b68b7ab1	320	is($m->bstr(),$rem->bstr(),"m $class $args[0] % $args[1]");
f9a08e12	321	# bmod() return agrees with set value?
b68b7ab1	322	is($tmod->bstr(),$m->bstr(),"o $class $args[0] % $args[1]");
f9a08e12	323
13a12e00	324	}
b3abae2a	325	}
b3abae2a	326
b68b7ab1	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.