From: Hugo van der Sanden Date: Thu, 22 Aug 2002 19:44:03 +0000 (+0000) Subject: new files from #17754 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f3d61276bee2ff0cc5e5e49de55d638b96e26b89;p=p5sagit%2Fp5-mst-13.2.git 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 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, L. + +=cut diff --git a/lib/Math/BigInt/t/bigints.t b/lib/Math/BigInt/t/bigints.t new file mode 100644 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; +