dslinux/user/perl/lib/Math/BigRat/t big_ap.t bigfltpm.inc bigfltrt.t bigrat.t bigratpm.inc bigratpm.t bigratup.t requirer.t trap.t

cayenne dslinux_cayenne at user.in-berlin.de
Mon Dec 4 18:00:51 CET 2006


Update of /cvsroot/dslinux/dslinux/user/perl/lib/Math/BigRat/t
In directory antilope:/tmp/cvs-serv17422/lib/Math/BigRat/t

Added Files:
	big_ap.t bigfltpm.inc bigfltrt.t bigrat.t bigratpm.inc 
	bigratpm.t bigratup.t requirer.t trap.t 
Log Message:
Adding fresh perl source to HEAD to branch from

--- NEW FILE: bigrat.t ---
#!/usr/bin/perl -w

use strict;
use Test;

BEGIN 
  {
  $| = 1;
  chdir 't' if -d 't';
  unshift @INC, '../lib'; # for running manually
  plan tests => 185;
  }

# basic testing of Math::BigRat

use Math::BigRat;
use Math::BigInt;
use Math::BigFloat;

# shortcuts
my $cr = 'Math::BigRat';		
my $mbi = 'Math::BigInt';
my $mbf = 'Math::BigFloat';

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

$x = Math::BigRat->new(1234); 		ok ($x,1234);
ok ($x->isa('Math::BigRat'));
ok (!$x->isa('Math::BigFloat'));
ok (!$x->isa('Math::BigInt'));

##############################################################################
# new and bnorm()

foreach my $func (qw/new bnorm/)
  {
  $x = $cr->$func(1234); 	ok ($x,1234);

  $x = $cr->$func('1234/1'); 	ok ($x,1234);
  $x = $cr->$func('1234/2'); 	ok ($x,617);

  $x = $cr->$func('100/1.0');	ok ($x,100);
  $x = $cr->$func('10.0/1.0');	ok ($x,10);
  $x = $cr->$func('0.1/10');	ok ($x,'1/100');
  $x = $cr->$func('0.1/0.1');	ok ($x,'1');
  $x = $cr->$func('1e2/10');	ok ($x,10);
  $x = $cr->$func('5/1e2');	ok ($x,'1/20');
  $x = $cr->$func('1e2/1e1');	ok ($x,10);
  $x = $cr->$func('1 / 3');	ok ($x,'1/3');
  $x = $cr->$func('-1 / 3');	ok ($x,'-1/3');
  $x = $cr->$func('NaN');	ok ($x,'NaN');
  $x = $cr->$func('inf');	ok ($x,'inf');
  $x = $cr->$func('-inf');	ok ($x,'-inf');
  $x = $cr->$func('1/');	ok ($x,'NaN');

  # input ala '1+1/3' isn't parsed ok yet
  $x = $cr->$func('1+1/3');	ok ($x,'NaN');
  
  $x = $cr->$func('1/1.2');	ok ($x,'5/6');
  $x = $cr->$func('1.3/1.2');	ok ($x,'13/12');
  $x = $cr->$func('1.2/1');	ok ($x,'6/5');

  ############################################################################
  # other classes as input

  $x = $cr->$func($mbi->new(1231));	ok ($x,'1231');
  $x = $cr->$func($mbf->new(1232));	ok ($x,'1232');
  $x = $cr->$func($mbf->new(1232.3));	ok ($x,'12323/10');
  }

my $n = 'numerator';
my $d = 'denominator';

$x =  $cr->new('-0'); ok ($x,'0'); 	ok ($x->$n(), '0'); ok ($x->$d(),'1');
$x =  $cr->new('NaN'); ok ($x,'NaN');	ok ($x->$n(), 'NaN'); ok ($x->$d(),'NaN');
$x =  $cr->new('-NaN'); ok ($x,'NaN');	ok ($x->$n(), 'NaN'); ok ($x->$d(),'NaN');
$x =  $cr->new('-1r4'); ok ($x,'NaN');	ok ($x->$n(), 'NaN'); ok ($x->$d(),'NaN');

$x =  $cr->new('+inf'); ok ($x,'inf');	ok ($x->$n(), 'inf'); ok ($x->$d(),'1');
$x =  $cr->new('-inf'); ok ($x,'-inf'); ok ($x->$n(), '-inf'); ok ($x->$d(),'1');
$x =  $cr->new('123a4'); ok ($x,'NaN'); ok ($x->$n(), 'NaN'); ok ($x->$d(),'NaN');

# wrong inputs
$x =  $cr->new('1e2e2'); ok ($x,'NaN'); ok ($x->$n(), 'NaN'); ok ($x->$d(),'NaN');
$x =  $cr->new('1+2+2'); ok ($x,'NaN'); ok ($x->$n(), 'NaN'); ok ($x->$d(),'NaN');
# failed due to BigFloat bug
$x =  $cr->new('1.2.2'); ok ($x,'NaN'); ok ($x->$n(), 'NaN'); ok ($x->$d(),'NaN');

ok ($cr->new('123a4'),'NaN');
ok ($cr->new('123e4'),'1230000');
ok ($cr->new('-NaN'),'NaN');
ok ($cr->new('NaN'),'NaN');
ok ($cr->new('+inf'),'inf');
ok ($cr->new('-inf'),'-inf');

##############################################################################
# two Bigints

ok ($cr->new($mbi->new(3),$mbi->new(7))->badd(1),'10/7');
ok ($cr->new($mbi->new(-13),$mbi->new(7)),'-13/7');
ok ($cr->new($mbi->new(13),$mbi->new(-7)),'-13/7');
ok ($cr->new($mbi->new(-13),$mbi->new(-7)),'13/7');

##############################################################################
# mixed arguments

ok ($cr->new('3/7')->badd(1),'10/7');
ok ($cr->new('3/10')->badd(1.1),'7/5');
ok ($cr->new('3/7')->badd($mbi->new(1)),'10/7');
ok ($cr->new('3/10')->badd($mbf->new('1.1')),'7/5');

ok ($cr->new('3/7')->bsub(1),'-4/7');
ok ($cr->new('3/10')->bsub(1.1),'-4/5');
ok ($cr->new('3/7')->bsub($mbi->new(1)),'-4/7');
ok ($cr->new('3/10')->bsub($mbf->new('1.1')),'-4/5');

ok ($cr->new('3/7')->bmul(1),'3/7');
ok ($cr->new('3/10')->bmul(1.1),'33/100');
ok ($cr->new('3/7')->bmul($mbi->new(1)),'3/7');
ok ($cr->new('3/10')->bmul($mbf->new('1.1')),'33/100');

ok ($cr->new('3/7')->bdiv(1),'3/7');
ok ($cr->new('3/10')->bdiv(1.1),'3/11');
ok ($cr->new('3/7')->bdiv($mbi->new(1)),'3/7');
ok ($cr->new('3/10')->bdiv($mbf->new('1.1')),'3/11');

##############################################################################
$x = $cr->new('1/4'); $y = $cr->new('1/3');

ok ($x + $y, '7/12');
ok ($x * $y, '1/12');
ok ($x / $y, '3/4');

$x = $cr->new('7/5'); $x *= '3/2'; 
ok ($x,'21/10');
$x -= '0.1';
ok ($x,'2');	# not 21/10

$x = $cr->new('2/3');		$y = $cr->new('3/2');
ok ($x > $y,'');		
ok ($x < $y,1);
ok ($x == $y,'');

$x = $cr->new('-2/3');		$y = $cr->new('3/2');
ok ($x > $y,'');		
ok ($x < $y,'1');
ok ($x == $y,'');

$x = $cr->new('-2/3');		$y = $cr->new('-2/3');
ok ($x > $y,'');		
ok ($x < $y,'');
ok ($x == $y,'1');

$x = $cr->new('-2/3');		$y = $cr->new('-1/3');
ok ($x > $y,'');		
ok ($x < $y,'1');
ok ($x == $y,'');

$x = $cr->new('-124');		$y = $cr->new('-122');
ok ($x->bacmp($y),1);

$x = $cr->new('-124');		$y = $cr->new('-122');
ok ($x->bcmp($y),-1);

$x = $cr->new('3/7');		$y = $cr->new('5/7');
ok ($x+$y,'8/7');

$x = $cr->new('3/7');		$y = $cr->new('5/7');
ok ($x*$y,'15/49');

$x = $cr->new('3/5');		$y = $cr->new('5/7');
ok ($x*$y,'3/7');

$x = $cr->new('3/5');		$y = $cr->new('5/7');
ok ($x/$y,'21/25');

$x = $cr->new('7/4');		$y = $cr->new('1');
ok ($x % $y,'3/4');

$x = $cr->new('7/4');		$y = $cr->new('5/13');
ok ($x % $y,'11/52');

$x = $cr->new('7/4');		$y = $cr->new('5/9');
ok ($x % $y,'1/12');

$x = $cr->new('-144/9')->bsqrt();	ok ($x,'NaN');
$x = $cr->new('144/9')->bsqrt();	ok ($x,'4');
$x = $cr->new('3/4')->bsqrt();		ok ($x,
  '1732050807568877293527446341505872366943/'
 .'2000000000000000000000000000000000000000');

##############################################################################
# bpow

$x = $cr->new('2/1');  $z = $x->bpow('3/1'); ok ($x,'8');
$x = $cr->new('1/2');  $z = $x->bpow('3/1'); ok ($x,'1/8');
$x = $cr->new('1/3');  $z = $x->bpow('4/1'); ok ($x,'1/81');
$x = $cr->new('2/3');  $z = $x->bpow('4/1'); ok ($x,'16/81');

# XXX todo:
#$x = $cr->new('2/3');  $z = $x->bpow('5/3'); ok ($x,'32/81 ???');

##############################################################################
# bfac

$x = $cr->new('1');  $x->bfac(); ok ($x,'1');
for (my $i = 0; $i < 8; $i++)
  {
  $x = $cr->new("$i/1")->bfac(); ok ($x,$mbi->new($i)->bfac());
  }

# test for $self->bnan() vs. $x->bnan();
$x = $cr->new('-1'); $x->bfac(); ok ($x,'NaN');	

##############################################################################
# binc/bdec

$x =  $cr->new('3/2'); ok ($x->binc(),'5/2');
$x =  $cr->new('15/6'); ok ($x->bdec(),'3/2');

##############################################################################
# bfloor/bceil

$x = $cr->new('-7/7'); ok ($x->$n(), '-1'); ok ($x->$d(), '1');
$x = $cr->new('-7/7')->bfloor(); ok ($x->$n(), '-1'); ok ($x->$d(), '1');

##############################################################################
# bsstr

$x = $cr->new('7/5')->bsstr(); ok ($x,'7/5');
$x = $cr->new('-7/5')->bsstr(); ok ($x,'-7/5');

##############################################################################
# numify()

my @array = qw/1 2 3 4 5 6 7 8 9/;
$x = $cr->new('8/8'); ok ($array[$x],2);
$x = $cr->new('16/8'); ok ($array[$x],3);
$x = $cr->new('17/8'); ok ($array[$x],3);
$x = $cr->new('33/8'); ok ($array[$x],5);
$x = $cr->new('-33/8'); ok ($array[$x],6);
$x = $cr->new('-8/1'); ok ($array[$x],2);	# -8 => 2

$x = $cr->new('33/8'); ok ($x->numify() * 1000, 4125);
$x = $cr->new('-33/8'); ok ($x->numify() * 1000, -4125);
$x = $cr->new('inf'); ok ($x->numify(), 'inf');
$x = $cr->new('-inf'); ok ($x->numify(), '-inf');
$x = $cr->new('NaN'); ok ($x->numify(), 'NaN');

$x = $cr->new('4/3'); ok ($x->numify(), 4/3);

##############################################################################
# as_hex(), as_bin()

$x = $cr->new('8/8');
ok ($x->as_hex(), '0x1'); ok ($x->as_bin(), '0b1');
$x = $cr->new('80/8');
ok ($x->as_hex(), '0xa'); ok ($x->as_bin(), '0b1010');

##############################################################################
# broot(), blog(), bmodpow() and bmodinv()

$x = $cr->new(2) ** 32;
$y = $cr->new(4);
$z = $cr->new(3);

ok ($x->copy()->broot($y), 2 ** 8);
ok (ref($x->copy()->broot($y)), $cr);

ok ($x->copy()->bmodpow($y,$z), 1);
ok (ref($x->copy()->bmodpow($y,$z)), $cr);

$x = $cr->new(8);
$y = $cr->new(5033);
$z = $cr->new(4404);

ok ($x->copy()->bmodinv($y), $z);
ok (ref($x->copy()->bmodinv($y)), $cr);

# square root with exact result
$x = $cr->new('1.44');
ok ($x->copy()->broot(2), '12/10');
ok (ref($x->copy()->broot(2)), $cr);

# log with exact result
$x = $cr->new('256.1');
ok ($x->copy()->blog(2), '8000563442710106079310294693803606983661/1000000000000000000000000000000000000000');
ok (ref($x->copy()->blog(2)), $cr);

$x = $cr->new(144);
ok ($x->copy()->broot('2'), 12, 'v/144 = 12');

$x = $cr->new(12*12*12);
ok ($x->copy()->broot('3'), 12, '(12*12*12) ** 1/3 = 12');

##############################################################################
# done

1;


--- NEW FILE: trap.t ---
#!/usr/bin/perl -w

# test that config ( trap_nan => 1, trap_inf => 1) really works/dies

use strict;
use Test;

BEGIN
  {
  $| = 1;
  chdir 't' if -d 't';
  unshift @INC, '../lib'; # for running manually
  plan tests => 29;
  } 

use Math::BigRat;

my $mbi = 'Math::BigRat';
my ($cfg,$x);

foreach my $class ($mbi)
  {
  # can do and defaults are okay?
  ok ($class->can('config'));
  ok ($class->config()->{trap_nan}, 0);
  ok ($class->config()->{trap_inf}, 0);

  # can set?
  $cfg = $class->config( trap_nan => 1 ); ok ($cfg->{trap_nan},1);
  
  # can set via hash ref?
  $cfg = $class->config( { trap_nan => 1 } ); ok ($cfg->{trap_nan},1);

  # also test that new() still works normally
  eval ("\$x = \$class->new('42'); \$x->bnan();");
  ok ($@ =~/^Tried to set/, 1);
  ok ($x,42); 				# after new() never modified

  # can reset?
  $cfg = $class->config( trap_nan => 0 ); ok ($cfg->{trap_nan},0);
  
  # can set?
  $cfg = $class->config( trap_inf => 1 ); ok ($cfg->{trap_inf},1);
  eval ("\$x = \$class->new('4711'); \$x->binf();");
  ok ($@ =~/^Tried to set/, 1);
  ok ($x,4711);				# after new() never modified
  
  # +$x/0 => +inf
  eval ("\$x = \$class->new('4711'); \$x->bdiv(0);");
  ok ($@ =~/^Tried to set/, 1);
  ok ($x,4711);				# after new() never modified
 
  # -$x/0 => -inf
  eval ("\$x = \$class->new('-0815'); \$x->bdiv(0);");
  ok ($@ =~/^Tried to set/, 1);
  ok ($x,-815);				# after new() never modified
  
  $cfg = $class->config( trap_nan => 1 );
  # 0/0 => NaN
  eval ("\$x = \$class->new('0'); \$x->bdiv(0);");
  ok ($@ =~/^Tried to set/, 1);
  ok ($x,0);				# after new() never modified
  }

##############################################################################
# BigRat

$cfg = Math::BigRat->config( trap_nan => 1 );

for my $trap (qw/0.1a +inf inf -inf/)
  {
  my $x = Math::BigRat->new('7/4');

  eval ("\$x = \$mbi->new('$trap');");
  print "# Got: $x\n" unless
   ok ($x,'7/4');			# never modified since it dies
  eval ("\$x = \$mbi->new('$trap');");
  print "# Got: $x\n" unless
   ok ($x,'7/4');			# never modified since it dies
  eval ("\$x = \$mbi->new('$trap/7');");
  print "# Got: $x\n" unless
   ok ($x,'7/4');			# never modified since it dies
  }

# all tests done


--- NEW FILE: bigratpm.inc ---
#include this file into another test for subclass testing...

ok ($class->config()->{lib},$CL);

$setup = '';

while (<DATA>)
  {
  chomp;
  $_ =~ s/#.*$//;	# remove comments
  $_ =~ s/\s+$//;	# trailing spaces
  next if /^$/;		# skip empty lines & comments
  if (s/^&//)
    {
    $f = $_;
    }
  elsif (/^\$/)
    {
    $setup = $_; $setup =~ s/\$/\$${class}::/g;	# round_mode, div_scale
    #print "\$setup== $setup\n";
    }
  else
    {
    if (m|^(.*?):(/.+)$|)
      {
      $ans = $2;
      @args = split(/:/,$1,99);
      }
    else
      {
      @args = split(/:/,$_,99); $ans = pop(@args);
      }
    $try = "\$x = new $class \"$args[0]\";";
    if ($f eq "bnorm")
      {
        $try .= "\$x;";
      } elsif ($f eq "finf") {
        my $a = $args[1] || '';
        $try .= "\$x->binf('$a');";
      } elsif ($f eq "is_inf") {
        $try .= "\$x->is_inf('$args[1]');"; 
      } elsif ($f eq "fone") {
        $try .= "\$x->bone('$args[1]');";
      } elsif ($f eq "fstr") {
        $try .= "\$x->accuracy($args[1]); \$x->precision($args[2]);";
        $try .= '$x->bstr();';
      } elsif ($f eq "parts") {
        # ->bstr() to see if an object is returned
        $try .= '($a,$b) = $x->parts(); $a = $a->bstr(); $b = $b->bstr();';
        $try .= '"$a $b";';
      } elsif ($f eq "numerator") {
        # ->bstr() to see if an object is returned
        $try .= '$x->numerator()->bstr();';
      } elsif ($f eq "denominator") {
        # ->bstr() to see if an object is returned
        $try .= '$x->denominator()->bstr();';
      } elsif ($f =~ /^(length|numify)$/) {
        $try .= "\$x->$f();";
      # some unary ops (can't test the fxxx form, since no AUTOLOAD in BigRat)
      } elsif ($f =~ /^f(nan|sstr|neg|floor|ceil|abs)$/) {
        $try .= "\$x->b$1();";
      # some is_xxx test function	
      } elsif ($f =~ /^is_(zero|one|pos|neg|negative|positive|odd|even|nan|int)\z/) {
        $try .= "\$x->$f();";
      } elsif ($f =~ /^(as_number|as_int)\z/){
        $try .= "\$x->$1();";
      } elsif ($f eq "finc") {
        $try .= '++$x;';
      } elsif ($f eq "fdec") {
        $try .= '--$x;';
      } elsif ($f eq "digit") {
        $try .= "\$x->digit($args[1]);";
      } elsif ($f eq "fround") {
        $try .= "$setup; \$x->bround($args[1]);";
      } elsif ($f eq "ffround") {
        $try .= "$setup; \$x->bfround($args[1]);";
      } elsif ($f eq "fsqrt") {
        $try .= "$setup; \$x->bsqrt();";
      } elsif ($f eq "flog") {
        $try .= "$setup; \$x->blog();";
      } elsif ($f eq "ffac") {
        $try .= "$setup; \$x->bfac();";
      }
    else
      {
      $try .= "\$y = new $class \"$args[1]\";";
      if ($f eq "bcmp") {
        $try .= '$x <=> $y;';
      } elsif ($f eq "bacmp") {
        $try .= '$x->bacmp($y);';
      } elsif ($f eq "bpow") {
        $try .= '$x ** $y;';
      } elsif ($f eq "fpow") {
        $try .= '$x->bpow($y);';
      } elsif ($f eq "badd") {
        $try .= '$x + $y;';
      } elsif ($f eq "bsub") {
        $try .= '$x - $y;';
      } elsif ($f eq "bmul") {
        $try .= '$x * $y;';
      } elsif ($f eq "bdiv") {
        $try .= "$setup; \$x / \$y;";
      } elsif ($f eq "fdiv-list") {
        $try .= "$setup; join(',',\$x->bdiv(\$y));";
      } elsif ($f eq "brsft") {
        $try .= '$x >> $y;';
      } elsif ($f eq "blsft") {
        $try .= '$x << $y;';
      } elsif ($f eq "bmod") {
        $try .= '$x % $y;';
      } elsif( $f eq "bmodinv") {
       $try .= "\$x->bmodinv(\$y);";
      } elsif( $f eq "blog") {
       $try .= "\$x->blog(\$y);";
      } else {
        $try .= "\$z = $class->new(\"$args[2]\");";

        # Functions with three arguments
        if( $f eq "bmodpow") {
          $try .= "\$x->bmodpow(\$y,\$z);";
        } else { warn "Unknown op '$f'"; }
      }
    }
    # print "# Trying: '$try'\n";
    $ans1 = eval $try;
    if ($ans =~ m|^/(.*)$|)
      {
      my $pat = $1;
      if ($ans1 =~ /$pat/)
        {
        ok (1,1);
        }
      else
        {
        print "# '$try' expected: /$pat/ got: '$ans1'\n" if !ok(1,0);
        }
      }
    else
      {
      if ($ans eq "")
        {
        ok_undef ($ans1);
        }
      else
        {
        print "# Tried: '$try'\n" if !ok ($ans1, $ans);
#        if (ref($ans1) eq "$class")
#	  {
#	  # float numbers are normalized (for now), so mantissa shouldn't have
#	  # trailing zeros
#	  #print $ans1->_trailing_zeros(),"\n";
#          print "# Has trailing zeros after '$try'\n"
#	   if !ok ($ans1->{_m}->_trailing_zeros(), 0);
#	  }
        }
      } # end pattern or string
    }
  } # end while

# check whether $class->new( Math::BigInt->new()) destroys it 
# ($y == 12 in this case)
$x = Math::BigInt->new(1200); $y = $class->new($x);
ok ($y,1200); ok ($x,1200);

###############################################################################
# zero,inf,one,nan

$x = $class->new(2); $x->bzero(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
$x = $class->new(2); $x->binf();  ok_undef ($x->{_a}); ok_undef ($x->{_p});
$x = $class->new(2); $x->bone();  ok_undef ($x->{_a}); ok_undef ($x->{_p});
$x = $class->new(2); $x->bnan();  ok_undef ($x->{_a}); ok_undef ($x->{_p});
        
1; # all done

###############################################################################
# Perl 5.005 does not like ok ($x,undef)

sub ok_undef
  {
  my $x = shift;

  ok (1,1) and return if !defined $x;
  ok ($x,'undef');
  }

__DATA__
&digit
123:2:1
1234:0:4
1234:1:3
1234:2:2
1234:3:1
1234:-1:1
1234:-2:2
1234:-3:3
1234:-4:4
0:0:0
0:1:0
&bmodinv
# format: number:modulus:result
# bmodinv Data errors
abc:abc:NaN
abc:5:NaN
5:abc:NaN
# bmodinv Expected Results from normal use
1:5:1
3:5:2
-2:5:2
8:5033:4404
1234567891:13:6
-1234567891:13:7
324958749843759385732954874325984357439658735983745:2348249874968739:1741662881064902
## bmodinv Error cases / useless use of function
3:-5:NaN
inf:5:NaN
5:inf:NaN
-inf:5:NaN
5:-inf:NaN
&as_number
144/7:20
12/1:12
-12/1:-12
-12/3:-4
NaN:NaN
+inf:inf
-inf:-inf
&as_int
144/7:20
12/1:12
-12/1:-12
-12/3:-4
NaN:NaN
+inf:inf
-inf:-inf
&bmodpow
# format: number:exponent:modulus:result
# bmodpow Data errors
abc:abc:abc:NaN
5:abc:abc:NaN
abc:5:abc:NaN
abc:abc:5:NaN
5:5:abc:NaN
5:abc:5:NaN
abc:5:5:NaN
# bmodpow Expected results
0:0:2:1
1:0:2:1
0:0:1:0
8:7:5032:3840
8:-1:5033:4404
98436739867439843769485798542749827593285729587325:43698764986460981048259837659386739857456983759328457:6943857329857295827698367:3104744730915914415259518
# bmodpow Error cases
8:8:-5:NaN
8:-1:16:NaN
inf:5:13:NaN
5:inf:13:NaN
&bmod
NaN:1:NaN
1:NaN:NaN
1:1:0
2:2:0
12:6:0
7/4:4/14:1/28
7/4:4/16:0
-7/4:4/16:0
-7/4:-4/16:0
7/4:-4/16:0
7/4:4/32:0
-7/4:4/32:0
-7/4:-4/32:0
7/4:-4/32:0
7/4:4/28:1/28
-7/4:4/28:-1/28
7/4:-4/28:1/28
-7/4:-4/28:-1/28
&fsqrt
1:1
0:0
NaN:NaN
+inf:inf
-inf:NaN
144:12
# sqrt(144) / sqrt(4) = 12/2 = 6/1
144/4:6
25/16:5/4
-3:NaN
&flog
NaN:NaN
0:NaN
-2:NaN
&blog
NaN:NaN:NaN
0:NaN:NaN
NaN:0:NaN
NaN:1:NaN
1:NaN:NaN
0:2:NaN
0:-2:NaN
3:-2:NaN
&finf
1:+:inf
2:-:-inf
3:abc:inf
&numify
0:0
+1:1
1234:1234
3/4:0.75
5/2:2.5
3/2:1.5
5/4:1.25
NaN:NaN
+inf:inf
-inf:-inf
&fnan
abc:NaN
2:NaN
-2:NaN
0:NaN
&fone
2:+:1
-2:-:-1
-2:+:1
2:-:-1
0::1
-2::1
abc::1
2:abc:1
&fsstr
+inf:inf
-inf:-inf
abcfsstr:NaN
1:1/1
3/1:3/1
0.1:1/10
&bnorm
1:1
-0:0
bnormNaN:NaN
+inf:inf
-inf:-inf
inf/inf:NaN
5/inf:0
5/-inf:0
inf/5:inf
-inf/5:-inf
inf/-5:-inf
-inf/-5:inf
123:123
-123.4567:-1234567/10000
# invalid inputs
1__2:NaN
1E1__2:NaN
11__2E2:NaN
#1.E3:NaN
.2E-3.:NaN
#1e3e4:NaN
.2E2:20
inf:inf
+inf:inf
-inf:-inf
+infinity:NaN
+-inf:NaN
abc:NaN
   1 a:NaN
1bcd2:NaN
11111b:NaN
+1z:NaN
-1z:NaN
0:0
+0:0
+00:0
+0_0_0:0
000000_0000000_00000:0
-0:0
-0000:0
+1:1
+01:1
+001:1
+00000100000:100000
+00000800/00000010:80
-00000800/00000010:-80
+00000800/-00000010:-80
-00000800/-00000010:80
123456789:123456789
-1:-1
-01:-1
-001:-1
-123456789:-123456789
-00000100000:-100000
123.456a:NaN
123.456:15432/125
0.01:1/100
.002:1/500
+.2:1/5
-0.0003:-3/10000
-.0000000004:-1/2500000000
123456E2:12345600
123456E-2:30864/25
-123456E2:-12345600
-123456E-2:-30864/25
1e1:10
2e-11:1/50000000000
12/10:6/5
0.1/0.1:1
100/0.1:1000
0.1/10:1/100
1 / 3:1/3
1/ 3:1/3
1 /3:1/3
&fneg
fnegNaN:NaN
+inf:-inf
-inf:inf
+0:0
+1:-1
-1:1
+123456789:-123456789
-123456789:123456789
+123.456789:-123456789/1000000
-123456.789:123456789/1000
123/7:-123/7
-123/7:123/7
123/-7:123/7
&fabs
fabsNaN:NaN
+inf:inf
-inf:inf
+0:0
+1:1
-1:1
+123456789:123456789
-123456789:123456789
+123.456789:123456789/1000000
-123456.789:123456789/1000
&badd
abc:abc:NaN
abc:+0:NaN
+0:abc:NaN
+inf:-inf:NaN
-inf:+inf:NaN
+inf:+inf:inf
-inf:-inf:-inf
baddNaN:+inf:NaN
baddNaN:+inf:NaN
+inf:baddNaN:NaN
-inf:baddNaN:NaN
+0:+0:0
+1:+0:1
+0:+1:1
+1:+1:2
-1:+0:-1
+0:-1:-1
-1:-1:-2
-1:+1:0
+1:-1:0
+9:+1:10
+99:+1:100
+999:+1:1000
+9999:+1:10000
+99999:+1:100000
+999999:+1:1000000
+9999999:+1:10000000
+99999999:+1:100000000
+999999999:+1:1000000000
+9999999999:+1:10000000000
+99999999999:+1:100000000000
+10:-1:9
+100:-1:99
+1000:-1:999
+10000:-1:9999
+100000:-1:99999
+1000000:-1:999999
+10000000:-1:9999999
+100000000:-1:99999999
+1000000000:-1:999999999
+10000000000:-1:9999999999
+123456789:+987654321:1111111110
-123456789:+987654321:864197532
-123456789:-987654321:-1111111110
+123456789:-987654321:-864197532
1/3:1/3:2/3
2/3:-1/3:1/3
&bsub
abc:abc:NaN
abc:+0:NaN
+0:abc:NaN
+inf:-inf:inf
-inf:+inf:-inf
+inf:+inf:NaN
-inf:-inf:NaN
baddNaN:+inf:NaN
baddNaN:+inf:NaN
+inf:baddNaN:NaN
-inf:baddNaN:NaN
+0:+0:0
+1:+0:1
+0:+1:-1
+1:+1:0
-1:+0:-1
+0:-1:1
-1:-1:0
-1:+1:-2
+1:-1:2
+9:+1:8
+99:+1:98
+999:+1:998
+9999:+1:9998
+99999:+1:99998
+999999:+1:999998
+9999999:+1:9999998
+99999999:+1:99999998
+999999999:+1:999999998
+9999999999:+1:9999999998
+99999999999:+1:99999999998
+10:-1:11
+100:-1:101
+1000:-1:1001
+10000:-1:10001
+100000:-1:100001
+1000000:-1:1000001
+10000000:-1:10000001
+100000000:-1:100000001
+1000000000:-1:1000000001
+10000000000:-1:10000000001
+123456789:+987654321:-864197532
-123456789:+987654321:-1111111110
-123456789:-987654321:864197532
+123456789:-987654321:1111111110
2/3:1/3:1/3
7/27:3/54:11/54
-2/3:+2/3:-4/3
-2/3:-2/3:0
0:-123:123
0:123:-123
&bmul
abc:abc:NaN
abc:+0:NaN
+0:abc:NaN
+inf:NaNmul:NaN
+inf:NaNmul:NaN
NaNmul:+inf:NaN
NaNmul:-inf:NaN
+inf:+inf:inf
+inf:-inf:-inf
+inf:-inf:-inf
+inf:+inf:inf
+inf:123.34:inf
+inf:-123.34:-inf
-inf:123.34:-inf
-inf:-123.34:inf
123.34:+inf:inf
-123.34:+inf:-inf
123.34:-inf:-inf
-123.34:-inf:inf
+0:+0:0
+0:+1:0
+1:+0:0
+0:-1:0
-1:+0:0
+123456789123456789:+0:0
+0:+123456789123456789:0
-1:-1:1
-1:+1:-1
+1:-1:-1
+1:+1:1
+2:+3:6
-2:+3:-6
+2:-3:-6
-2:-3:6
+111:+111:12321
+10101:+10101:102030201
+1001001:+1001001:1002003002001
+100010001:+100010001:10002000300020001
+10000100001:+10000100001:100002000030000200001
+11111111111:+9:99999999999
+22222222222:+9:199999999998
+33333333333:+9:299999999997
+44444444444:+9:399999999996
+55555555555:+9:499999999995
+66666666666:+9:599999999994
+77777777777:+9:699999999993
+88888888888:+9:799999999992
+99999999999:+9:899999999991
6:120:720
10:10000:100000
1/4:1/3:1/12
&bdiv
$div_scale = 40; $round_mode = 'even'
abc:abc:NaN
abc:+1:abc:NaN
+1:abc:NaN
-1:abc:NaN
0:abc:NaN
+0:+0:NaN
+0:+1:0
+1:+0:inf
+3214:+0:inf
+0:-1:0
-1:+0:-inf
-3214:+0:-inf
+1:+1:1
-1:-1:1
+1:-1:-1
-1:+1:-1
+1:+2:1/2
+2:+1:2
123:+inf:0
123:-inf:0
+10:+5:2
+100:+4:25
+1000:+8:125
+10000:+16:625
+10000:-16:-625
+999999999999:+9:111111111111
+999999999999:+99:10101010101
+999999999999:+999:1001001001
+999999999999:+9999:100010001
+999999999999999:+99999:10000100001
+1000000000:+9:1000000000/9
+2000000000:+9:2000000000/9
+3000000000:+9:1000000000/3
+4000000000:+9:4000000000/9
+5000000000:+9:5000000000/9
+6000000000:+9:2000000000/3
+7000000000:+9:7000000000/9
+8000000000:+9:8000000000/9
+9000000000:+9:1000000000
+35500000:+113:35500000/113
+71000000:+226:35500000/113
+106500000:+339:35500000/113
+1000000000:+3:1000000000/3
2:25.024996000799840031993601279744051189762:1000000000000000000000000000000000000000/12512498000399920015996800639872025594881
123456:1:123456
1/4:1/3:3/4
# reset scale for further tests
$div_scale = 40
&is_nan
123:0
abc:1
NaN:1
-123:0
&is_inf
+inf::1
-inf::1
abc::0
1::0
NaN::0
-1::0
+inf:-:0
+inf:+:1
-inf:-:1
-inf:+:0
# it must be exactly /^[+-]inf$/
+infinity::0
-infinity::0
&is_odd
abc:0
0:0
-1:1
-3:1
1:1
3:1
1000001:1
1000002:0
+inf:0
-inf:0
123.45:0
-123.45:0
2:0
&is_int
NaNis_int:0
0:1
1:1
2:1
-2:1
-1:1
-inf:0
+inf:0
123.4567:0
-0.1:0
-0.002:0
1/3:0
3/1:1
&is_even
abc:0
0:1
-1:0
-3:0
1:0
3:0
1000001:0
1000002:1
2:1
+inf:0
-inf:0
123.456:0
-123.456:0
0.01:0
-0.01:0
120:1
1200:1
-1200:1
&is_pos
0:0
1:1
-1:0
-123:0
NaN:0
-inf:0
+inf:1
&is_positive
0:0
1:1
-1:0
-123:0
NaN:0
-inf:0
+inf:1
&is_neg
0:0
1:0
-1:1
-123:1
NaN:0
-inf:1
+inf:0
&is_negative
0:0
1:0
-1:1
-123:1
NaN:0
-inf:1
+inf:0
&parts
0:0 1
1:1 1
123:123 1
-123:-123 1
-1200:-1200 1
5/7:5 7
-5/7:-5 7
NaNparts:NaN NaN
+inf:inf inf
-inf:-inf inf
&length
123:3
-123:3
0:1
1:1
12345678901234567890:20
&is_zero
NaNzero:0
+inf:0
-inf:0
0:1
-1:0
1:0
0/3:1
1/3:0
-0/3:1
5/inf:1
&is_one
NaNone:0
+inf:0
-inf:0
0:0
2:0
1:1
-1:0
-2:0
1/3:0
100/100:1
0.1/0.1:1
5/inf:0
&ffloor
0:0
abc:NaN
+inf:inf
-inf:-inf
1:1
-51:-51
-51.2:-52
12.2:12
3/7:0
6/7:0
7/7:1
8/7:1
13/7:1
14/7:2
15/7:2
-3/7:-1
-6/7:-1
-7/1:-7
-8/7:-2
-13/7:-2
-14/7:-2
-15/7:-3
&fceil
0:0
abc:NaN
+inf:inf
-inf:-inf
1:1
-51:-51
-51.2:-51
12.2:13
3/7:1
6/7:1
8/7:2
13/7:2
14/7:2
15/7:3
-3/7:0
-6/7:0
-8/7:-1
-13/7:-1
-14/7:-2
-15/7:-2
&ffac
NaN:NaN
1:1
-1:NaN
&bpow
# bpow test for overload of **
2:2:4
3:3:27
&bacmp
+0:-0:0
+0:+1:-1
-1:+1:0
+1:-1:0
-1:+2:-1
+2:-1:1
-123456789:+987654321:-1
+123456789:-987654321:-1
+987654321:+123456789:1
-987654321:+123456789:1
-123:+4567889:-1
# NaNs
acmpNaN:123:
123:acmpNaN:
acmpNaN:acmpNaN:
# infinity
+inf:+inf:0
-inf:-inf:0
+inf:-inf:0
-inf:+inf:0
+inf:123:1
-inf:123:1
+inf:-123:1
-inf:-123:1
+inf:1/23:1
-inf:1/23:1
+inf:-1/23:1
-inf:-1/23:1
+inf:12/3:1
-inf:12/3:1
+inf:-12/3:1
-inf:-12/3:1
123:inf:-1
-123:inf:-1
123:-inf:-1
-123:-inf:-1
1/23:inf:-1
-1/23:inf:-1
1/23:-inf:-1
-1/23:-inf:-1
12/3:inf:-1
-12/3:inf:-1
12/3:-inf:-1
-12/3:-inf:-1
# return undef
+inf:NaN:
NaN:inf:
-inf:NaN:
NaN:-inf:
1/3:2/3:-1
2/3:1/3:1
2/3:2/3:0
&fpow
2/1:3/1:8
3/1:3/1:27
5/2:3/1:125/8
-2/1:3/1:-8
-3/1:3/1:-27
-5/2:3/1:-125/8
-2/1:4/1:16
-3/1:4/1:81
-5/2:4/1:625/16
-5/2:-4/1:16/625
1/5:-3:125
-1/5:-3:-125
&numerator
NaN:NaN
inf:inf
-inf:-inf
3/7:3
-3/7:-3
0:0
1:1
5/-3:-5
&denominator
NaN:NaN
inf:1
-inf:1
3/7:7
0:1
1/1:1
-1/1:1
-3/7:7
4/-5:5
&finc
3/2:5/2
-15/6:-3/2
NaN:NaN
-1/3:2/3
-2/7:5/7
&fdec
15/6:3/2
-3/2:-5/2
1/3:-2/3
2/7:-5/7
NaN:NaN

--- NEW FILE: requirer.t ---
#!/usr/bin/perl -w

# check that simple requiring BigRat works

use strict;
use Test::More;

BEGIN
  {
  $| = 1;
  # to locate the testing files
  my $location = $0; $location =~ s/requirer.t//i;
  if ($ENV{PERL_CORE})
    {
    # testing with the core distribution
    @INC = qw(../t/lib);
    }
  unshift @INC, qw(../lib);     # to locate the modules
  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";

  plan tests => 1;
  } 

my ($x);

require Math::BigRat; $x = Math::BigRat->new(1); ++$x;

is ($x, 2, '$x got successfully modified');

# all tests done


--- NEW FILE: bigratup.t ---
#!/usr/bin/perl -w

# Test whether $Math::BigInt::upgrade breaks our neck

use Test::More;
use strict;

BEGIN
  {
  $| = 1;
  chdir 't' if -d 't';
  unshift @INC, '../lib';
  plan tests => 5;
  }

use Math::BigInt upgrade => 'Math::BigRat';
use Math::BigRat;

my $rat = 'Math::BigRat';
my ($x,$y,$z);

##############################################################################
# bceil/bfloor

$x = $rat->new('49/4'); is ($x->bfloor(),'12', 'floor(49/4)');
$x = $rat->new('49/4'); is ($x->bceil(),'13', 'ceil(49/4)');

##############################################################################
# bsqrt

$x = $rat->new('144'); is ($x->bsqrt(),'12', 'bsqrt(144)');
$x = $rat->new('144/16'); is ($x->bsqrt(),'3', 'bsqrt(144/16)');
$x = $rat->new('1/3'); is ($x->bsqrt(),
 '1000000000000000000000000000000000000000/1732050807568877293527446341505872366943',
 'bsqrt(1/3)');

# all tests successfull

1;


--- NEW FILE: bigratpm.t ---
#!/usr/bin/perl -w

use Test;
use strict;

BEGIN
  {
  $| = 1;
  # to locate the testing files
  my $location = $0; $location =~ s/bigratpm.t//i;
  if ($ENV{PERL_CORE})
    {
    # testing with the core distribution
    @INC = qw(../lib);
    }
  unshift @INC, '../lib';
  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";

  plan tests => 686;
  }

use Math::BigRat lib => 'Calc';

use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL);
$class = "Math::BigRat";
$CL = "Math::BigInt::Calc";
 
require 'bigratpm.inc';	# all tests here for sharing

--- NEW FILE: big_ap.t ---
#!/usr/bin/perl -w

# Test that accuracy() and precision() in BigInt/BigFloat do not disturb
# the rounding force in BigRat.

use Test;
use strict;

BEGIN
  {
  $| = 1;
  chdir 't' if -d 't';
  unshift @INC, '../lib';
  plan tests => 17;
  }

use Math::BigInt;
use Math::BigFloat;
use Math::BigRat;

my $r = 'Math::BigRat';
my $proper = $r->new('12345678901234567890/2');
my $proper_inc = $r->new('12345678901234567890/2')->binc();
my $proper_dec = $r->new('12345678901234567890/2')->bdec();
my $proper_int = Math::BigInt->new('12345678901234567890');
my $proper_float = Math::BigFloat->new('12345678901234567890');
my $proper2 = $r->new('12345678901234567890');

print "# Start\n";

Math::BigInt->accuracy(3);
Math::BigFloat->accuracy(5);

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

##############################################################################
# new()

$z = $r->new('12345678901234567890/2');
ok ($z,$proper);

$z = $r->new('1234567890123456789E1');
ok ($z,$proper2);

$z = $r->new('12345678901234567890/1E0');
ok ($z,$proper2);
$z = $r->new('1234567890123456789e1/1');
ok ($z,$proper2);
$z = $r->new('1234567890123456789e1/1E0');
ok ($z,$proper2);

$z = $r->new($proper_int);
ok ($z,$proper2);

$z = $r->new($proper_float);
ok ($z,$proper2);

##############################################################################
# bdiv

$x = $r->new('12345678901234567890'); $y = Math::BigRat->new('2');
$z = $x->copy->bdiv($y);
ok ($z,$proper);

##############################################################################
# bmul

$x = $r->new("$proper"); $y = Math::BigRat->new('1');
$z = $x->copy->bmul($y);
ok ($z,$proper);
$z = $r->new('12345678901234567890/1E0');
ok ($z,$proper2);

$z = $r->new($proper_int);
ok ($z,$proper2);

$z = $r->new($proper_float);
ok ($z,$proper2);

##############################################################################
# bdiv

$x = $r->new('12345678901234567890'); $y = Math::BigRat->new('2');
$z = $x->copy->bdiv($y);
ok ($z,$proper);

##############################################################################
# bmul

$x = $r->new("$proper"); $y = Math::BigRat->new('1');
$z = $x->copy->bmul($y);
ok ($z,$proper);

$x = $r->new("$proper"); $y = Math::BigRat->new('2');
$z = $x->copy->bmul($y);
ok ($z,$proper2);

##############################################################################
# binc/bdec

$x = $proper->copy()->binc(); ok ($x,$proper_inc);
$x = $proper->copy()->bdec(); ok ($x,$proper_dec);


--- NEW FILE: bigfltrt.t ---
#!/usr/bin/perl -w

use Test;
use strict;

BEGIN
  {
  $| = 1;
  # to locate the testing files
  my $location = $0; $location =~ s/bigfltrt.t//i;
  if ($ENV{PERL_CORE})
    {
    # testing with the core distribution
    @INC = qw(../t/lib);
    }
  unshift @INC, '../lib';
  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";

  plan tests => 1;
  }

use Math::BigRat::Test;		# test via this Subclass 

use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL);
$class = "Math::BigRat::Test";
$CL = "Math::BigInt::Calc";
 
ok (1,1);

# fails stil 185 tests
#require 'bigfltpm.inc';		# all tests here for sharing

--- NEW FILE: bigfltpm.inc ---
#include this file into another test for subclass testing...

ok ($class->config()->{lib},$CL);

use strict;

while (<DATA>)
  {
  chomp;
  $_ =~ s/#.*$//;	# remove comments
  $_ =~ s/\s+$//;	# trailing spaces
  next if /^$/;		# skip empty lines & comments
  if (s/^&//)
    {
    $f = $_;
    }
  elsif (/^\$/)
    {
    $setup = $_; $setup =~ s/\$/\$${class}::/g;	# round_mode, div_scale
[...1405 lines suppressed...]
+inf:inf
-inf:-inf
1:1
-51:-51
-51.2:-52
12.2:12
0.12345:0
0.123456:0
0.1234567:0
0.12345678:0
0.123456789:0
&fceil
0:0
abc:NaN
+inf:inf
-inf:-inf
1:1
-51:-51
-51.2:-51
12.2:13




More information about the dslinux-commit mailing list