new files from #17754

p4raw-id: //depot/perl@17755

diff --git a/lib/Math/BigInt/Scalar.pm b/lib/Math/BigInt/Scalar.pm
new file mode 100644 (file)
index 0000000..44bab5d
--- /dev/null
+++ b/lib/Math/BigInt/Scalar.pm
@@ -0,0 +1,242 @@
+###############################################################################
+# core math lib for BigInt, representing big numbers by normal int/float's
+# for testing only, will fail any bignum test if range is exceeded
+
+package Math::BigInt::Scalar;
+
+use 5.005;
+use strict;
+# use warnings; # dont use warnings for older Perls
+
+require Exporter;
+
+use vars qw/@ISA $VERSION/;
+@ISA = qw(Exporter);
+
+$VERSION = '0.11';
+
+##############################################################################
+# global constants, flags and accessory
+ 
+# constants for easier life
+my $nan = 'NaN';
+
+##############################################################################
+# create objects from various representations
+
+sub _new
+  {
+  # (string) return ref to num
+  my $d = $_[1];
+  my $x = $$d; # make copy
+  return \$x;
+  }                                                                             
+
+sub _zero
+  {
+  my $x = 0; return \$x;
+  }
+
+sub _one
+  {
+  my $x = 1; return \$x;
+  }
+
+sub _copy
+  {
+  my $x = $_[1];
+  my $z = $$x;
+  return \$z;
+  }
+
+# catch and throw away
+sub import { }
+
+##############################################################################
+# convert back to string and number
+
+sub _str
+  {
+  # make string
+  return \"${$_[1]}";
+  }                                                                             
+
+sub _num
+  {
+  # make a number
+  return ${$_[1]};
+  }
+
+
+##############################################################################
+# actual math code
+
+sub _add
+  {
+  my ($c,$x,$y) = @_;
+  $$x += $$y;
+  return $x;
+  }                                                                             
+
+sub _sub
+  {
+  my ($c,$x,$y) = @_;
+  $$x -= $$y;
+  return $x;
+  }                                                                             
+
+sub _mul
+  {
+  my ($c,$x,$y) = @_;
+  $$x *= $$y;
+  return $x;
+  }                                                                             
+
+sub _div
+  {
+  my ($c,$x,$y) = @_;
+
+  my $u = int($$x / $$y); my $r = $$x % $$y; $$x = $u;
+  return ($x,\$r) if wantarray;
+  return $x;
+  }                                                                             
+
+sub _pow
+  {
+  my ($c,$x,$y) = @_;
+  my $u = $$x ** $$y; $$x = $u;
+  return $x;
+  }
+
+sub _and
+  {
+  my ($c,$x,$y) = @_;
+  my $u = int($$x) & int($$y); $$x = $u;
+  return $x;
+  }
+
+sub _xor
+  {
+  my ($c,$x,$y) = @_;
+  my $u = int($$x) ^ int($$y); $$x = $u;
+  return $x;
+  }
+
+sub _or
+  {
+  my ($c,$x,$y) = @_;
+  my $u = int($$x) | int($$y); $$x = $u;
+  return $x;
+  }
+
+sub _inc
+  {
+  my ($c,$x) = @_;
+  my $u = int($$x)+1; $$x = $u;
+  return $x;
+  }
+
+sub _dec
+  {
+  my ($c,$x) = @_;
+  my $u = int($$x)-1; $$x = $u;
+  return $x;
+  }
+
+##############################################################################
+# testing
+
+sub _acmp
+  {
+  my ($c,$x, $y) = @_;
+  return ($$x <=> $$y);
+  }
+
+sub _len
+  {
+  return length("${$_[1]}");
+  }
+
+sub _digit
+  {
+  # return the nth digit, negative values count backward
+  # 0 is the rightmost digit
+  my ($c,$x,$n) = @_;
+  
+  $n ++;                       # 0 => 1, 1 => 2
+  return substr($$x,-$n,1);    # 1 => -1, -2 => 2 etc
+  }
+
+##############################################################################
+# _is_* routines
+
+sub _is_zero
+  {
+  # return true if arg is zero
+  my ($c,$x) = @_;
+  return ($$x == 0) <=> 0;
+  }
+
+sub _is_even
+  {
+  # return true if arg is even
+  my ($c,$x) = @_;
+  return (!($$x & 1)) <=> 0; 
+  }
+
+sub _is_odd
+  {
+  # return true if arg is odd
+  my ($c,$x) = @_;
+  return ($$x & 1) <=> 0;
+  }
+
+sub _is_one
+  {
+  # return true if arg is one
+  my ($c,$x) = @_;
+  return ($$x == 1) <=> 0;
+  }
+
+###############################################################################
+# check routine to test internal state of corruptions
+
+sub _check
+  {
+  # no checks yet, pull it out from the test suite
+  my ($c,$x) = @_;
+  return "$x is not a reference" if !ref($x);
+  return 0;
+  }
+
+1;
+__END__
+
+=head1 NAME
+
+Math::BigInt::Scalar - Pure Perl module to test Math::BigInt with scalars
+
+=head1 SYNOPSIS
+
+Provides support for big integer calculations via means of 'small' int/floats.
+Only for testing purposes, since it will fail at large values. But it is simple
+enough not to introduce bugs on it's own and to serve as a testbed.
+
+=head1 DESCRIPTION
+
+Please see Math::BigInt::Calc.
+
+=head1 LICENSE
+ 
+This program is free software; you may redistribute it and/or modify it under
+the same terms as Perl itself. 
+
+=head1 AUTHOR
+
+Tels http://bloodgate.com in 2001.
+
+=head1 SEE ALSO
+
+L<Math::BigInt>, L<Math::BigInt::Calc>.
+
+=cut

diff --git a/lib/Math/BigInt/t/bigints.t b/lib/Math/BigInt/t/bigints.t
new file mode 100644 (file)
index 0000000..fb9b2f4
--- /dev/null
+++ b/lib/Math/BigInt/t/bigints.t
@@ -0,0 +1,109 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test;
+
+BEGIN 
+  {
+  $| = 1;
+  # chdir 't' if -d 't';
+  unshift @INC, '../lib'; # for running manually
+  plan tests => 51;
+  }
+
+# testing of Math::BigInt::BitVect, primarily for interface/api and not for the
+# math functionality
+
+use Math::BigInt::Scalar;
+
+my $C = 'Math::BigInt::Scalar';        # pass classname to sub's
+
+# _new and _str
+my $x = $C->_new(\"123"); my $y = $C->_new(\"321");
+ok (ref($x),'SCALAR'); ok (${$C->_str($x)},123); ok (${$C->_str($y)},321);
+
+# _add, _sub, _mul, _div
+
+ok (${$C->_str($C->_add($x,$y))},444);
+ok (${$C->_str($C->_sub($x,$y))},123);
+ok (${$C->_str($C->_mul($x,$y))},39483);
+ok (${$C->_str($C->_div($x,$y))},123);
+
+ok (${$C->_str($C->_mul($x,$y))},39483);
+ok (${$C->_str($x)},39483);
+ok (${$C->_str($y)},321);
+my $z = $C->_new(\"2");
+ok (${$C->_str($C->_add($x,$z))},39485);
+my ($re,$rr) = $C->_div($x,$y);
+
+ok (${$C->_str($re)},123); ok (${$C->_str($rr)},2);
+
+# is_zero, _is_one, _one, _zero
+ok ($C->_is_zero($x),0);
+ok ($C->_is_one($x),0);
+
+ok ($C->_is_one($C->_one()),1); ok ($C->_is_one($C->_zero()),0);
+ok ($C->_is_zero($C->_zero()),1); ok ($C->_is_zero($C->_one()),0);
+
+# is_odd, is_even
+ok ($C->_is_odd($C->_one()),1); ok ($C->_is_odd($C->_zero()),0);
+ok ($C->_is_even($C->_one()),0); ok ($C->_is_even($C->_zero()),1);
+
+# _digit
+$x = $C->_new(\"123456789");
+ok ($C->_digit($x,0),9);
+ok ($C->_digit($x,1),8);
+ok ($C->_digit($x,2),7);
+ok ($C->_digit($x,-1),1);
+ok ($C->_digit($x,-2),2);
+ok ($C->_digit($x,-3),3);
+
+# _copy
+$x = $C->_new(\"12356");
+ok (${$C->_str($C->_copy($x))},12356);
+
+# _acmp
+$x = $C->_new(\"123456789");
+$y = $C->_new(\"987654321");
+ok ($C->_acmp($x,$y),-1);
+ok ($C->_acmp($y,$x),1);
+ok ($C->_acmp($x,$x),0);
+ok ($C->_acmp($y,$y),0);
+
+# _div
+$x = $C->_new(\"3333"); $y = $C->_new(\"1111");
+ok (${$C->_str( scalar $C->_div($x,$y))},3);
+$x = $C->_new(\"33333"); $y = $C->_new(\"1111"); ($x,$y) = $C->_div($x,$y);
+ok (${$C->_str($x)},30); ok (${$C->_str($y)},3);
+$x = $C->_new(\"123"); $y = $C->_new(\"1111"); 
+($x,$y) = $C->_div($x,$y); ok (${$C->_str($x)},0); ok (${$C->_str($y)},123);
+
+# _num
+$x = $C->_new(\"12345"); $x = $C->_num($x); ok (ref($x)||'',''); ok ($x,12345);
+
+# _len
+$x = $C->_new(\"12345"); $x = $C->_len($x); ok (ref($x)||'',''); ok ($x,5);
+
+# _and, _or, _xor
+$x = $C->_new(\"3"); $y = $C->_new(\"4"); ok (${$C->_str( $C->_or($x,$y))},7);
+$x = $C->_new(\"1"); $y = $C->_new(\"4"); ok (${$C->_str( $C->_xor($x,$y))},5);
+$x = $C->_new(\"7"); $y = $C->_new(\"3"); ok (${$C->_str( $C->_and($x,$y))},3);
+
+# _pow
+$x = $C->_new(\"2"); $y = $C->_new(\"4"); ok (${$C->_str( $C->_pow($x,$y))},16);
+$x = $C->_new(\"2"); $y = $C->_new(\"5"); ok (${$C->_str( $C->_pow($x,$y))},32);
+$x = $C->_new(\"3"); $y = $C->_new(\"3"); ok (${$C->_str( $C->_pow($x,$y))},27);
+
+
+# should not happen:
+# $x = $C->_new(\"-2"); $y = $C->_new(\"4"); ok ($C->_acmp($x,$y),-1);
+
+# _check
+$x = $C->_new(\"123456789");
+ok ($C->_check($x),0);
+ok ($C->_check(123),'123 is not a reference');
+
+# done
+
+1;
+