# $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $
#
-# Generated on Sat Jun 8 19:17:45 EET DST 2002 [metaconfig 3.0 PL70]
+# Generated on Mon Jun 10 07:25:01 EET DST 2002 [metaconfig 3.0 PL70]
# (with additional metaconfig patches by perlbug@perl.org)
cat >c1$$ <<EOF
lib/Net/Netrc.pm libnet
lib/Net/NNTP.pm libnet
lib/Net/Ping.pm Hello, anybody home?
-lib/Net/Ping/CHANGES Net::Ping
+lib/Net/Ping/Changes Net::Ping
lib/Net/Ping/README Net::Ping
lib/Net/Ping/t/100_load.t Ping Net::Ping
lib/Net/Ping/t/110_icmp_inst.t Ping Net::Ping
such as '5.6.1', api_revision is the '5'.
Prior to 5.5.640, the format was a floating point number,
like 5.00563.
- perl.c:incpush() and lib/lib.pm will automatically search in
+
+ perl.c:incpush() and lib/lib.pm will automatically search in
$sitelib/.. for older directories back to the limit specified
by these api_ variables. This is only useful if you have a
perl library directory tree structured like the default one.
directory was introduced in 5.005, so that is the lowest
possible value. The version list appropriate for the current
system is determined in inc_version_list.U.
- XXX To do: Since compatibility can depend on compile time
+
+ XXX To do: Since compatibility can depend on compile time
options (such as bincompat, longlong, etc.) it should
(perhaps) be set by Configure, but currently it isn't.
Currently, we read a hard-wired value from patchlevel.h.
long doubles, respectively. If present, they contain a
space-separated list of one or more of the above function
names in the order they should be tried.
- d_Gconvert may be set to override Configure with a platform-
+
+ d_Gconvert may be set to override Configure with a platform-
specific function. If this function expects a double, a
different value may need to be set by the uselongdouble.cbu
call-back unit so that long doubles can be formatted without
directory dedicated to perl (e.g. /opt/perl), while the latter
is useful if $prefix is shared by many packages, e.g. if
$prefix=/usr/local.
- This may later be extended to include other information, so
+
+ This may later be extended to include other information, so
be careful with pattern-matching on the results.
- For compatibility with perl5.005 and earlier, the default
+
+ For compatibility with perl5.005 and earlier, the default
setting is based on whether or not $prefix contains the string
"perl".
installed perl5.005 or later suitable for running the script
to determine inc_version_list.
-perl5 (perl5.U):
- This variable contains the full path (if any) to a previously
- installed perl5.005 or later suitable for running the script
- to determine inc_version_list.
-
perl (Loc.U):
This variable is defined but not used by Configure.
The value is a plain '' and is not useful.
though in principle we could go snooping around in old
Config.pm files.
+yacc (yacc.U):
+ This variable holds the name of the compiler compiler we
+ want to use in the Makefile. It can be yacc, byacc, or bison -y.
+
yaccflags (yacc.U):
This variable contains any additional yacc flags desired by the
user. It is up to the Makefile to use this.
# Package name : perl5
# Source directory : .
-# Configuration time: Sat Jun 8 19:29:36 EET DST 2002
+# Configuration time: Mon Jun 10 07:26:05 EET DST 2002
# Configured by : jhi
# Target system : osf1 alpha.hut.fi v4.0 878 alpha
ccversion='V5.6-082'
cf_by='jhi'
cf_email='yourname@yourhost.yourplace.com'
-cf_time='Sat Jun 8 19:29:36 EET DST 2002'
+cf_time='Mon Jun 10 07:26:05 EET DST 2002'
charsize='1'
chgrp=''
chmod='chmod'
/*
* Package name : perl5
* Source directory : .
- * Configuration time: Sat Jun 8 19:29:36 EET DST 2002
+ * Configuration time: Mon Jun 10 07:26:05 EET DST 2002
* Configured by : jhi
* Target system : osf1 alpha.hut.fi v4.0 878 alpha
*/
s |I32 |expect_number |char** pattern
#
# if defined(USE_ITHREADS)
-s |SV* |gv_share |SV *sv
+s |SV* |gv_share |SV *sv|CLONE_PARAMS *param
# endif
#endif
# endif
#define expect_number(a) S_expect_number(aTHX_ a)
# if defined(USE_ITHREADS)
-#define gv_share(a) S_gv_share(aTHX_ a)
+#define gv_share(a,b) S_gv_share(aTHX_ a,b)
# endif
#endif
#if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT)
#print "$file $method\n";
open(FILE, $file) or die "Can't open $file: $!";
+ eval { binmode(FILE, ":bytes") }; # Perl 5.8.0+ only
my $digest = Digest::MD5->new->addfile(*FILE)->$method();
close(FILE);
my($file) = @_;
local $/; # slurp
open(FILE, $file) or die "Can't open $file: $!";
+ eval { binmode(FILE, ":bytes") }; # Perl 5.8.0+ only
my $tmp = <FILE>;
close(FILE);
$tmp;
my $dir = dirname(__FILE__);
my $seq = 1;
-for my $charset (sort keys %Charset){
+for my $charset (sort keys %Charset) {
my ($src, $uni, $dst, $txt);
my $transcoder = find_encoding($Charset{$charset}[0]) or die;
if (PerlIO::Layer->find('perlio')){
binmode($dst, ":utf8");
print $dst $uni;
- }else{ # ugh!
+ } else { # ugh!
binmode($dst);
my $raw = $uni; Encode::_utf8_off($raw);
print $dst $raw;
if (PerlIO::Layer->find('perlio')){
binmode($src, ":utf8");
$uni = join('', <$src>);
- }else{ # ugh!
+ } else { # ugh!
binmode($src);
$uni = join('', <$src>);
Encode::_utf8_on($uni);
open $dst,">$dst_enc" or die "$dst_utf : $!";
binmode($dst);
+ binmode($dst, ":bytes"); # in case LC_ALL is UTF8ish
print $dst $txt;
close($dst);
is(compare_text($src_enc, $dst_enc), 0 => "$dst_enc eq $src_enc")
my $jisx0212 = File::Spec->catfile(dirname(__FILE__), 'jisx0212.utf');
open my $fh, $jisx0208 or die "$jisx0208: $!";
+binmode($fh, ":bytes");
$utf8off = join('' => <$fh>);
close $fh;
$utf8on = decode('utf8', $utf8off);
for my $name (keys %CJKT){
open my $fh, $CJKT{$name} or die "$CJKT{$name}: $!";
+ binmode($fh, ":bytes");
$utf8off = join('' => <$fh>);
close $fh;
unlink $file or die "Can't unlink '$file': $!";
open FH, ">$file" or die "Can't open '$file': $!";
binmode FH;
+ eval { binmode(FH, ":bytes") }; # Perl 5.8.0+ only
print FH $data or die "Can't print to '$file': $!";
close FH or die "Can't close '$file': $!";
local (*FH, $/);
open FH, "<$file" or die "Can't open '$file': $!";
binmode FH;
+ eval { binmode(FH, ":bytes") }; # Perl 5.8.0+ only
my $contents = <FH>;
die "Can't read $file: $!" unless defined $contents;
return $contents;
}
PUTBACK;
if (SvTRUE(ERRSV)) {
- Perl_warn(aTHX_ "Died:%" SVf,ERRSV);
+ Perl_warn(aTHX_ "thread failed to start: %" SVf, ERRSV);
}
FREETMPS;
LEAVE;
# - tries to check for various compiler versions and do the right
# thing when it can
# - warnings turned off (-n32 messages):
-# 1116 - non-void function should return a value
-# 1048 - cast between pointer-to-object and pointer-to-function
-# 1042 - operand types are incompatible
+# 1184 - "=" is used where where "==" may have been intended
+# 1552 - variable "foo" set but never used
# Tweaked by Chip Salzenberg <chip@perl.com> on 5/13/97
# - don't assume 'cc -n32' if the n32 libm.so is missing
# _p: precision
# _f: flags, used to signal MBI not to touch our private parts
-$VERSION = '1.32';
+$VERSION = '1.33';
require 5.005;
use Exporter;
use File::Spec;
push @a, $_[$i];
}
}
-# print "mbf @a\n";
# let use Math::BigInt lib => 'GMP'; use Math::BigFloat; still work
my $mbilib = eval { Math::BigInt->config()->{lib} };
{
# MBI not loaded, or with ne "Math::BigInt"
$lib .= ",$mbilib" if defined $mbilib;
-
-# my @parts = split /::/, $MBI; # Math::BigInt => Math BigInt
-# my $file = pop @parts; $file .= '.pm'; # BigInt => BigInt.pm
-# $file = File::Spec->catfile (@parts, $file);
-
+ $lib =~ s/^,//; # don't leave empty
if ($] < 5.006)
{
# Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is
# used in the same script, or eval inside import().
my @parts = split /::/, $MBI; # Math::BigInt => Math BigInt
my $file = pop @parts; $file .= '.pm'; # BigInt => BigInt.pm
+ require File::Spec;
$file = File::Spec->catfile (@parts, $file);
- eval { require $file; $MBI->import( lib => '$lib', 'objectify' ); }
+ eval { require "$file"; };
+ $MBI->import( lib => $lib, 'objectify' );
}
else
{
my $class = "Math::BigInt";
require 5.005;
-$VERSION = '1.57';
+$VERSION = '1.58';
use Exporter;
@ISA = qw( Exporter );
@EXPORT_OK = qw( objectify _swap bgcd blcm);
{
my $xsign = $x->{sign};
$x->{sign} = $y->{sign};
- $x = $y-$x if $xsign ne $y->{sign}; # one of them '-'
+ if ($xsign ne $y->{sign})
+ {
+ my $t = [ @{$x->{value}} ]; # copy $x
+ $x->{value} = [ @{$y->{value}} ]; # copy $y to $x
+ $x->{value} = $CALC->_sub($y->{value},$t,1); # $y-$x
+ }
}
else
{
$x;
}
-sub bmodinv_not_yet_implemented
+sub bmodinv
{
# modular inverse. given a number which is (hopefully) relatively
# prime to the modulus, calculate its inverse using Euclid's
|| $num->is_zero() # or num == 0
|| $num->{sign} !~ /^[+-]$/ # or num NaN, inf, -inf
);
-# return $num # i.e., NaN or some kind of infinity,
-# if ($num->{sign} =~ /\w/);
+ return $num # i.e., NaN or some kind of infinity,
+ if ($num->{sign} !~ /^[+-]$/);
+
+ if ($CALC->can('_modinv'))
+ {
+ $num->{value} = $CALC->_modinv($mod->{value});
+ return $num;
+ }
# the remaining case, nonpositive case, $num < 0, is addressed below.
my ($a, $b) = ($mod->copy(), $num->copy());
# put least residue into $b if $num was negative
- $b %= $mod if $b->{sign} eq '-';
+ $b->bmod($mod) if $b->{sign} eq '-';
- # Euclid's Algorithm
- while( ! $b->is_zero()) {
- ($a, my $q, $b) = ($b, $self->bdiv( $a->copy(), $b));
- ($u, $u1) = ($u1, $u - $u1 * $q);
+ # Euclid's Algorithm
+ while (!$b->is_zero())
+ {
+ ($a, my $q, $b) = ($b, $a->copy()->bdiv($b));
+ ($u, $u1) = ($u1, $u - $u1 * $q);
}
- # if the gcd is not 1, then return NaN! It would be pointless to
- # have called bgcd first, because we would then be performing the
- # same Euclidean Algorithm *twice*
- return $self->bnan() unless $a->is_one();
+ # if the gcd is not 1, then return NaN! It would be pointless to
+ # have called bgcd first, because we would then be performing the
+ # same Euclidean Algorithm *twice*
+ return $num->bnan() unless $a->is_one();
- $u %= $mod;
- return $u;
+ $u->bmod($mod);
+ $num->{value} = $u->{value};
+ $num->{sign} = $u->{sign};
+ $num;
}
-sub bmodpow_not_yet_implemented
+sub bmodpow
{
# takes a very large number to a very large exponent in a given very
# large modulus, quickly, thanks to binary exponentation. supports
# i.e., if it's NaN, +inf, or -inf...
return $num->bnan();
}
- elsif ($exp->{sign} eq '-')
+
+ my $exp1 = $exp->copy();
+ if ($exp->{sign} eq '-')
{
- $exp->babs();
+ $exp1->babs();
$num->bmodinv ($mod);
- return $num if $num->{sign} !~ /^[+-]/; # i.e. if there was no inverse
+ # return $num if $num->{sign} !~ /^[+-]/; # see next check
}
- # check num for valid values
- return $num->bnan() if $num->{sign} !~ /^[+-]$/;
+ # check num for valid values (also NaN if there was no inverse)
+ return $num->bnan() if $num->{sign} !~ /^[+-]$/;
- # in the trivial case,
- return $num->bzero() if $mod->is_one();
- return $num->bone() if $num->is_zero() or $num->is_one();
+ if ($CALC->can('_modpow'))
+ {
+ # $exp and $mod are positive, result is also positive
+ $num->{value} = $CALC->_modpow($num->{value},$exp->{value},$mod->{value});
+ return $num;
+ }
- my $acc = $num->copy(); $num->bone(); # keep ref to $num
+ # in the trivial case,
+ return $num->bzero() if $mod->is_one();
+ return $num->bone() if $num->is_zero() or $num->is_one();
- print "$num $acc $exp\n";
- while( !$exp->is_zero() ) {
- if( $exp->is_odd() ) {
- $num->bmul($acc)->bmod($mod);
+ $num->bmod($mod); # if $x is large, make it smaller first
+ my $acc = $num->copy(); $num->bone(); # keep ref to $num
+
+ while( !$exp1->is_zero() )
+ {
+ if( $exp1->is_odd() )
+ {
+ $num->bmul($acc)->bmod($mod);
}
- $acc->bmul($acc)->bmod($mod);
- $exp->brsft( 1, 2); # remove last (binary) digit
- print "$num $acc $exp\n";
+ $acc->bmul($acc)->bmod($mod);
+ $exp1->brsft( 1, 2); # remove last (binary) digit
}
- return $num;
+ $num;
}
###############################################################################
$CALC = ''; # signal error
foreach my $lib (@c)
{
+ next if ($lib || '') eq '';
$lib = 'Math::BigInt::'.$lib if $lib !~ /^Math::BigInt/i;
$lib =~ s/\.pm$//;
if ($] < 5.006)
{
# Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is
# used in the same script, or eval inside import().
- (my $mod = $lib . '.pm') =~ s!::!/!g;
- # require does not automatically :: => /, so portability problems arise
- eval { require $mod; $lib->import( @c ); }
+ my @parts = split /::/, $lib; # Math::BigInt => Math BigInt
+ my $file = pop @parts; $file .= '.pm'; # BigInt => BigInt.pm
+ require File::Spec;
+ $file = File::Spec->catfile (@parts, $file);
+ eval { require "$file"; $lib->import( @c ); }
}
else
{
$es = $1; $ev = $2;
# valid mantissa?
return if $m eq '.' || $m eq '';
- my ($mi,$mf) = split /\./,$m;
+ my ($mi,$mf,$last) = split /\./,$m;
+ return if defined $last; # last defined => 1.2.3 or others
$mi = '0' if !defined $mi;
$mi .= '0' if $mi =~ /^[\-\+]?$/;
$mf = '0' if !defined $mf || $mf eq '';
# return (quo,rem) or quo if scalar
$x->bmod($y); # modulus (x % y)
+ $x->bmodpow($exp,$mod); # modular exponentation (($num**$exp) % $mod))
+ $x->bmodinv($mod); # the inverse of $x in the given modulus $mod
$x->bpow($y); # power of arguments (x ** y)
$x->blsft($y); # left shift
=head2 bmodinv
-Not yet implemented.
-
bmodinv($num,$mod); # modular inverse (no OO style)
Returns the inverse of C<$num> in the given modulus C<$mod>. 'C<NaN>' is
=head2 bmodpow
-Not yet implemented.
-
bmodpow($num,$exp,$mod); # modular exponentation ($num**$exp % $mod)
Returns the value of C<$num> taken to the power C<$exp> in the modulus
use vars qw/@ISA $VERSION/;
@ISA = qw(Exporter);
-$VERSION = '0.28';
+$VERSION = '0.29';
# Package to store unsigned big integers in decimal and do math with them
$e = 5 if $^O =~ /^uts/; # UTS get's some special treatment
$e = 5 if $^O =~ /^unicos/; # unicos is also problematic (6 seems to work
# there, but we play safe)
+ $e = 5 if $] < 5.006; # cap, for older Perls
$e = 7 if $e > 7; # cap, for VMS, OS/390 and other 64 bit systems
# 8 fails inside random testsuite, so take 7
#print "case 1 (swap)\n";
for $i (@$sx)
{
- # we can't do an early out if $x is than $y, since we
+ # we can't do an early out if $x is < than $y, since we
# need to copy the high chunks from $y. Found by Bob Mathews.
#last unless defined $sy->[$j] || $car;
$sy->[$j] += $BASE
$x;
}
-sub _modinv
+##############################################################################
+# special modulus functions
+
+sub _modinv1
{
# inverse modulus
}
sub _modpow
{
# modulus of power ($x ** $y) % $z
+ my ($c,$num,$exp,$mod) = @_;
+
+ # in the trivial case,
+ if (_is_one($c,$mod))
+ {
+ splice @$num,0,1; $num->[0] = 0;
+ return $num;
+ }
+ if ((scalar @$num == 1) && (($num->[0] == 0) || ($num->[0] == 1)))
+ {
+ $num->[0] = 1;
+ return $num;
+ }
+
+# $num = _mod($c,$num,$mod);
+
+ my $acc = _copy($c,$num); my $t = _one();
+
+ my $two = _two();
+ my $exp1 = _copy($c,$exp); # keep arguments
+ while (!_is_zero($c,$exp1))
+ {
+ if (_is_odd($c,$exp1))
+ {
+ _mul($c,$t,$acc);
+ $t = _mod($c,$t,$mod);
+ }
+ _mul($c,$acc,$acc);
+ $acc = _mod($c,$acc,$mod);
+ _div($c,$exp1,$two);
+# print "exp ",${_str($c,$exp1)},"\n";
+# print "acc ",${_str($c,$acc)},"\n";
+# print "num ",${_str($c,$num)},"\n";
+# print "mod ",${_str($c,$mod)},"\n";
+ }
+ @$num = @$t;
+ $num;
}
##############################################################################
}
print "# INC = @INC\n";
- plan tests => 1601;
+ plan tests => 1599;
}
use Math::BigFloat lib => 'BareCalc';
}
print "# INC = @INC\n";
- plan tests => 2237;
+ plan tests => 2361;
}
use Math::BigInt lib => 'BareCalc';
# 1.41..7 and not 1.4170 since fallback (bsqrt(9) is '3', not 3.0...0)
2:0.5:1.41421356237309504880168872420969807857
#2:0.2:1.148698354997035006798626946777927589444
-6:1.5:14.6969384566990685891837044482353483518
+#6:1.5:14.6969384566990685891837044482353483518
$div_scale = 20;
#62.5:12.5:26447206647554886213592.3959144
$div_scale = 40;
}
print "# INC = @INC\n";
- plan tests => 1601
+ plan tests => 1599
+ 2; # own tests
}
$ans1 = eval $try;
print "# Tried: '$try'\n" if !ok ($ans1, $class->new(10) ** 10);
+###############################################################################
# test whether op destroys args or not (should better not)
$x = $class->new(3);
$x = $class->new(-5); $y = abs($x);
ok ($x, -5);
+$x = $class->new(8);
+$y = $class->new(-1);
+$z = $class->new(5033);
+my $u = $x->copy()->bmodpow($y,$z);
+ok ($u,4404);
+ok ($y,-1);
+ok ($z,5033);
+
+$x = $class->new(-5); $y = -$x; ok ($x,-5); ok ($y,5);
+$x = $class->new(-5); $y = $x->copy()->bneg(); ok ($x,-5); ok ($y,5);
+
+$x = $class->new(-5); $y = $class->new(3); $x->bmul($y); ok ($x,-15); ok ($y,3);
+$x = $class->new(-5); $y = $class->new(3); $x->badd($y); ok ($x,-2); ok ($y,3);
+$x = $class->new(-5); $y = $class->new(3); $x->bsub($y); ok ($x,-8); ok ($y,3);
+$x = $class->new(-15); $y = $class->new(3); $x->bdiv($y); ok ($x,-5); ok ($y,3);
+$x = $class->new(-5); $y = $class->new(3); $x->bmod($y); ok ($x,1); ok ($y,3);
+
+$x = $class->new(5); $y = $class->new(3); $x->bmul($y); ok ($x,15); ok ($y,3);
+$x = $class->new(5); $y = $class->new(3); $x->badd($y); ok ($x,8); ok ($y,3);
+$x = $class->new(5); $y = $class->new(3); $x->bsub($y); ok ($x,2); ok ($y,3);
+$x = $class->new(15); $y = $class->new(3); $x->bdiv($y); ok ($x,5); ok ($y,3);
+$x = $class->new(5); $y = $class->new(3); $x->bmod($y); ok ($x,2); ok ($y,3);
+
+$x = $class->new(5); $y = $class->new(-3); $x->bmul($y); ok ($x,-15); ok($y,-3);
+$x = $class->new(5); $y = $class->new(-3); $x->badd($y); ok ($x,2); ok($y,-3);
+$x = $class->new(5); $y = $class->new(-3); $x->bsub($y); ok ($x,8); ok($y,-3);
+$x = $class->new(15); $y = $class->new(-3); $x->bdiv($y); ok ($x,-5); ok($y,-3);
+$x = $class->new(5); $y = $class->new(-3); $x->bmod($y); ok ($x,-1); ok($y,-3);
+
+###############################################################################
# check whether overloading cmp works
$try = "\$x = $class->new(0);";
$try .= "\$y = 10;";
ok ($y,'0'); is_valid($y); # $y not '-0'
###############################################################################
+# bug in $x->bmod($y) if $x < 0 and $y > 0
+
+$x = $class->new('-629'); ok ($x->bmod(5033),4404);
+
+###############################################################################
# bone/binf etc as plain calls (Lite failed them)
ok ($class->bzero(),0);
&%=
100:3:1
8:9:8
+-629:5033:4404
&/=
100:3:33
-8:2:-4
1e2e3:NaN
1e2r:NaN
1e2.0:NaN
+# bug with two '.' in number beeing valid
+1.2.2:NaN
+1.2.3e1:NaN
+-1.2.3:NaN
+-1.2.3e-4:NaN
+1.2e3.4:NaN
+1.2e-3.4:NaN
+1.2.3.4:NaN
+1.2.t:NaN
+1..2:NaN
+1..2e1:NaN
+1..2e1..1:NaN
+12e1..1:NaN
+..2:NaN
+.-2:NaN
# leading zeros
012:12
0123:123
14:3:4
# bug in Calc with '99999' vs $BASE-1
10000000000000000000000000000000000000000000000000000000000000000000000000000000000:10000000375084540248994272022843165711074:999999962491547381984643365663244474111576
-#&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
-#324958749843759385732954874325984357439658735983745:2348249874968739:1741662881064902
+&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
+324958749843759385732954874325984357439658735983745:2348249874968739:1741662881064902
## bmodinv Error cases / useless use of function
-#3:-5:NaN
-#inf:5:NaN
-#&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
+3:-5:NaN
+inf:5:NaN
+&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
# inf handling, see table in doc
0:inf:0
12345678912345:113:53
1234567891234567:113:56
123456789123456789:113:39
+# bug in bmod() not modifying the variable in place
+-629:5033:4404
&bgcd
abc:abc:NaN
abc:+0:NaN
my $location = $0; $location =~ s/bigintpm.t//;
unshift @INC, $location; # to locate the testing files
chdir 't' if -d 't';
- plan tests => 2237;
+ plan tests => 2361;
}
use Math::BigInt;
}
print "# INC = @INC\n";
plan tests => 141;
+ if ($] < 5.006)
+ {
+ for (1..141) { skip (1,'Not supported on older Perls'); }
+ exit;
+ }
}
package Math::BigInt::Test;
chdir 't' if -d 't';
unshift @INC, '../lib'; # for running manually
plan tests => 7;
+ if ($] < 5.006)
+ {
+ for (1..7) { skip (1,'Not supported on older Perls'); }
+ exit;
+ }
}
use Math::BigInt ':constant';
BEGIN
{
- if ($^O eq 'os390') { print "1..0\n"; exit(0) }
$| = 1;
unshift @INC, '../lib'; # for running manually
my $location = $0; $location =~ s/mbi_rand.t//;
# together digits, we would end up with "1272398823211223" etc.
while (length($As) < $la) { $As .= int(rand(100)) x int(rand(16)); }
while (length($Bs) < $lb) { $Bs .= int(rand(100)) x int(rand(16)); }
- # Strip leading zeros, but don't let As and Bs end up empty.
- $As =~ s/^0+//; $Bs =~ s/^0+//;
- $As = '0' if $As eq '';
- $Bs = '0' if $Bs eq '';
- $A = $c->new($As); $B = $c->new($Bs);
+ $As =~ s/^0+//; $Bs =~ s/^0+//;
+ $As = $As || '0'; $Bs = $Bs || '0';
# print "# As $As\n# Bs $Bs\n";
+ $A = $c->new($As); $B = $c->new($Bs);
# print "# A $A\n# B $B\n";
if ($A->is_zero() || $B->is_zero())
{
unless ok ($ADB*$A+$two*$AMB-$AMB,$Bs);
}
-
}
print "# INC = @INC\n";
- plan tests => 1601
+ plan tests => 1599
+ 6; # + our own tests
}
}
print "# INC = @INC\n";
- plan tests => 2237
- + 5; # +4 own tests
+ plan tests => 2361
+ + 5; # +5 own tests
}
use Math::BigInt::Subclass;
}
print "# INC = @INC\n";
- plan tests => 1601
+ plan tests => 1599
+ 1;
}
package Net::Ping;
-# $Id: Ping.pm,v 1.34 2002/05/06 17:37:54 rob Exp $
+# $Id: Ping.pm,v 1.1 2002/06/04 00:41:52 rob Exp $
require 5.002;
require Exporter;
use strict;
use vars qw(@ISA @EXPORT $VERSION
- $def_timeout $def_proto $max_datasize $pingstring $hires);
+ $def_timeout $def_proto $max_datasize $pingstring $hires $udp_source_verify);
use FileHandle;
use Socket qw( SOCK_DGRAM SOCK_STREAM SOCK_RAW PF_INET
inet_aton inet_ntoa sockaddr_in );
@ISA = qw(Exporter);
@EXPORT = qw(pingecho);
-$VERSION = "2.18";
+$VERSION = "2.19";
# Constants
$max_datasize = 1024; # Maximum data bytes in a packet
# The data we exchange with the server for the stream protocol
$pingstring = "pingschwingping!\n";
+$udp_source_verify = 1; # Default is to verify source endpoint
if ($^O =~ /Win32/i) {
# Hack to avoid this Win32 spewage:
}
+# Description: Allow UDP source endpoint comparision to be
+# skipped for those remote interfaces that do
+# not response from the same endpoint.
+
+sub source_verify
+{
+ my $self = shift;
+ $udp_source_verify = 1 unless defined
+ ($udp_source_verify = ((defined $self) && (ref $self)) ? shift() : $self);
+}
+
# Description: allows the module to use milliseconds as returned by
# the Time::HiRes module
$from_saddr = recv($self->{"fh"}, $from_msg, 1500, UDP_FLAGS)
or last; # For example an unreachable host will make recv() fail.
($from_port, $from_ip) = sockaddr_in($from_saddr);
- if (($from_ip eq $ip) && # Does the packet check out?
- ($from_port == $self->{"port_num"}) &&
- ($from_msg eq $msg))
+ if (!$udp_source_verify ||
+ (($from_ip eq $ip) && # Does the packet check out?
+ ($from_port == $self->{"port_num"}) &&
+ ($from_msg eq $msg)))
{
$ret = 1; # It's a winner
$done = 1;
Net::Ping - check a remote host for reachability
-$Id: Ping.pm,v 1.34 2002/05/06 17:37:54 rob Exp $
+$Id: Ping.pm,v 1.1 2002/06/04 00:41:52 rob Exp $
=head1 SYNOPSIS
otherwise. The maximum number of data bytes that can be specified is
1024.
+=item $p->source_verify( { 0 | 1 } );
+
+Allows source endpoint verification to be enabled or disabled.
+This is useful for those remote destinations with multiples
+interfaces where the response may not originate from the same
+endpoint that the original destination endpoint was sent to.
+
+This is enabled by default.
+
=item $p->hires( { 0 | 1 } );
Causes this module to use Time::HiRes module, allowing milliseconds
to be returned by subsequent calls to ping().
+This is disabled by default.
+
=item $p->bind($local_addr);
Sets the source address from which pings will be sent. This must be
CHANGES
-------
+2.19 Jun 03 19:00 2002
+ - Add $p->udp_source_verify method to skip source
+ endpoint verification of udp protocol pings for
+ those remote destinations with multiple interfaces
+ that may have the "reverse telnet" bug.
+ - Moved files to more standard locations.
+
2.18 May 06 12:00 2002
- More RPM spec generalizations.
NAME
Net::Ping - check a remote host for reachability
- $Id: Ping.pm,v 1.34 2002/05/06 17:37:54 rob Exp $
+ $Id: Ping.pm,v 1.1 2002/06/04 00:41:52 rob Exp $
SYNOPSIS
use Net::Ping;
otherwise. The maximum number of data bytes that can be specified is
1024.
+ $p->source_verify( { 0 | 1 } );
+ Allows source endpoint verification to be enabled or disabled. This
+ is useful for those remote destinations with multiples interfaces
+ where the response may not originate from the same endpoint that the
+ original destination endpoint was sent to.
+
+ This is enabled by default.
+
$p->hires( { 0 | 1 } );
Causes this module to use Time::HiRes module, allowing milliseconds
to be returned by subsequent calls to ping().
+ This is disabled by default.
+
$p->bind($local_addr);
Sets the source address from which pings will be sent. This must be
the address of one of the interfaces on the local host. $local_addr
=item *
+C<our> can now have an experimental optional attribute C<unique> that
+affects how global variables are shared among multiple interpreters,
+see L<perlfunc/our>.
+
+=item *
+
The following builtin functions are now overridable: each(), keys(),
pop(), push(), shift(), splice(), unshift(). [561]
target of the change to
%ENV which produced the warning.
+=item thread failed to start: %s
+
+(F) The entry point function of threads->create() failed for some reason.
+
=item times not implemented
(F) Your version of the C library apparently doesn't do times(). I
our $VERSION : unique = "1.00";
Note that this attribute also has the effect of making the global
-readonly in the main interpreter after the first new interpreter
-has been cloned (for example, after the first new thread has been
-created).
+readonly when the first new interpreter is cloned (for example,
+when the first new thread is created).
Multi-interpreter environments can come to being either through the
fork() emulation on Windows platforms, or by embedding perl in a
STATIC I32 S_expect_number(pTHX_ char** pattern);
#
# if defined(USE_ITHREADS)
-STATIC SV* S_gv_share(pTHX_ SV *sv);
+STATIC SV* S_gv_share(pTHX_ SV *sv, CLONE_PARAMS *param);
# endif
#endif
for (tblent = *otblent; tblent; i=0, tblent = tblent->next) {
if (tblent->oldval == oldv) {
tblent->newval = newv;
- tbl->tbl_items++;
return;
}
}
/* attempt to make everything in the typeglob readonly */
STATIC SV *
-S_gv_share(pTHX_ SV *sstr)
+S_gv_share(pTHX_ SV *sstr, CLONE_PARAMS *param)
{
GV *gv = (GV*)sstr;
- SV *sv = &PL_sv_no; /* just need SvREADONLY-ness */
+ SV *sv = ¶m->proto_perl->Isv_no; /* just need SvREADONLY-ness */
if (GvIO(gv) || GvFORM(gv)) {
GvUNIQUE_off(gv); /* GvIOs cannot be shared. nor can GvFORMs */
}
else {
/* CvPADLISTs cannot be shared */
- if (!CvXSUB(GvCV(gv))) {
+ if (!SvREADONLY(GvCV(gv)) && !CvXSUB(GvCV(gv))) {
GvUNIQUE_off(gv);
}
}
case SVt_PVGV:
if (GvUNIQUE((GV*)sstr)) {
SV *share;
- if ((share = gv_share(sstr))) {
+ if ((share = gv_share(sstr, param))) {
del_SV(dstr);
dstr = share;
+ ptr_table_store(PL_ptr_table, sstr, dstr);
#if 0
PerlIO_printf(Perl_debug_log, "sv_dup: sharing %s::%s\n",
HvNAME(GvSTASH(share)), GvNAME(share));
# endif /* DEBUGGING */
#endif /* PERL_IMPLICIT_SYS */
param->flags = flags;
+ param->proto_perl = proto_perl;
/* arena roots */
PL_xiv_arenaroot = NULL;
struct clone_params {
AV* stashes;
UV flags;
+ PerlInterpreter *proto_perl;
};
# uses Calc, but only features the strictly necc. methods.
-use Math::BigInt::Calc '0.18';
+use Math::BigInt::Calc '0.29';
BEGIN
{
+ no strict 'refs';
foreach (qw/ base_len new zero one two copy str num add sub mul div inc dec
acmp len digit zeros
is_zero is_one is_odd is_even is_one check
/)
{
my $name = "Math::BigInt::Calc::_$_";
- no strict 'refs';
*{"Math::BigInt::BareCalc::_$_"} = \&$name;
}
}
projects / p5sagit/p5-mst-13.2.git / commitdiff