dslinux/user/perl/t/lib/Math/BigInt BareCalc.pm Scalar.pm Subclass.pm
cayenne
dslinux_cayenne at user.in-berlin.de
Mon Dec 4 18:01:53 CET 2006
Update of /cvsroot/dslinux/dslinux/user/perl/t/lib/Math/BigInt
In directory antilope:/tmp/cvs-serv17422/t/lib/Math/BigInt
Added Files:
BareCalc.pm Scalar.pm Subclass.pm
Log Message:
Adding fresh perl source to HEAD to branch from
--- NEW FILE: Subclass.pm ---
#!/usr/bin/perl -w
package Math::BigInt::Subclass;
require 5.005_02;
use strict;
use Exporter;
use Math::BigInt (1.64);
# $lib is for the "lib => " test
use vars qw($VERSION @ISA $PACKAGE @EXPORT_OK
$lib
$accuracy $precision $round_mode $div_scale);
@ISA = qw(Exporter Math::BigInt);
@EXPORT_OK = qw(bgcd objectify);
$VERSION = 0.04;
use overload; # inherit overload from BigInt
# Globals
$accuracy = $precision = undef;
$round_mode = 'even';
$div_scale = 40;
$lib = '';
sub new
{
my $proto = shift;
my $class = ref($proto) || $proto;
my $value = shift;
my $a = $accuracy; $a = $_[0] if defined $_[0];
my $p = $precision; $p = $_[1] if defined $_[1];
my $self = Math::BigInt->new($value,$a,$p,$round_mode);
bless $self,$class;
$self->{'_custom'} = 1; # make sure this never goes away
return $self;
}
sub bgcd
{
Math::BigInt::bgcd(@_);
}
sub blcm
{
Math::BigInt::blcm(@_);
}
BEGIN
{
*objectify = \&Math::BigInt::objectify;
# these are called by AUTOLOAD from BigFloat, so we need at least these.
# We cheat, of course..
*bneg = \&Math::BigInt::bneg;
*babs = \&Math::BigInt::babs;
*bnan = \&Math::BigInt::bnan;
*binf = \&Math::BigInt::binf;
*bzero = \&Math::BigInt::bzero;
*bone = \&Math::BigInt::bone;
}
sub import
{
my $self = shift;
my @a; my $t = 0;
foreach (@_)
{
# remove the "lib => foo" parameters and store it
$lib = $_, $t = 0, next if $t == 1;
if ($_ eq 'lib')
{
$t = 1; next;
}
push @a,$_;
}
$self->SUPER::import(@a); # need it for subclasses
$self->export_to_level(1,$self, at a); # need this ?
}
1;
--- NEW FILE: BareCalc.pm ---
package Math::BigInt::BareCalc;
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.02';
sub api_version () { 1; }
# Package to to test Bigint's simulation of Calc
# uses Calc, but only features the strictly necc. methods.
use Math::BigInt::Calc '0.40';
BEGIN
{
no strict 'refs';
foreach (qw/
base_len new zero one two ten copy str num add sub mul div mod inc dec
acmp len digit zeros
rsft lsft
fac pow gcd log_int sqrt root
is_zero is_one is_odd is_even is_one is_two is_ten check
as_hex as_bin from_hex from_bin
modpow modinv
and xor or
/)
{
my $name = "Math::BigInt::Calc::_$_";
*{"Math::BigInt::BareCalc::_$_"} = \&$name;
}
print "# BareCalc using Calc v$Math::BigInt::Calc::VERSION\n";
}
# catch and throw away
sub import { }
1;
--- NEW FILE: Scalar.pm ---
###############################################################################
# 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.12';
sub api_version() { 1; }
##############################################################################
# global constants, flags and accessory
# constants for easier life
my $nan = 'NaN';
##############################################################################
# create objects from various representations
sub _new
{
# create scalar ref from string
my $d = $_[1];
my $x = $d; # make copy
\$x;
}
sub _from_hex
{
# not used
}
sub _from_bin
{
# not used
}
sub _zero
{
my $x = 0; \$x;
}
sub _one
{
my $x = 1; \$x;
}
sub _two
{
my $x = 2; \$x;
}
sub _ten
{
my $x = 10; \$x;
}
sub _copy
{
my $x = $_[1];
my $z = $$x;
\$z;
}
# catch and throw away
sub import { }
##############################################################################
# convert back to string and number
sub _str
{
# make string
"${$_[1]}";
}
sub _num
{
# make a number
0+${$_[1]};
}
sub _zeros
{
my $x = $_[1];
$x =~ /\d(0*)$/;
length($1 || '');
}
sub _rsft
{
# not used
}
sub _lsft
{
# not used
}
sub _mod
{
# not used
}
sub _gcd
{
# not used
}
sub _sqrt
{
# not used
}
sub _root
{
# not used
}
sub _fac
{
# not used
}
sub _modinv
{
# not used
}
sub _modpow
{
# not used
}
sub _log_int
{
# not used
}
sub _as_hex
{
sprintf("0x%x",${$_[1]});
}
sub _as_bin
{
sprintf("0b%b",${$_[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) = @_;
($$x == 0) <=> 0;
}
sub _is_even
{
# return true if arg is even
my ($c,$x) = @_;
(!($$x & 1)) <=> 0;
}
sub _is_odd
{
# return true if arg is odd
my ($c,$x) = @_;
($$x & 1) <=> 0;
}
sub _is_one
{
# return true if arg is one
my ($c,$x) = @_;
($$x == 1) <=> 0;
}
sub _is_two
{
# return true if arg is one
my ($c,$x) = @_;
($$x == 2) <=> 0;
}
sub _is_ten
{
# return true if arg is one
my ($c,$x) = @_;
($$x == 10) <=> 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
More information about the dslinux-commit
mailing list