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