This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate mainline
authorNick Ing-Simmons <nik@tiuk.ti.com>
Mon, 10 Jun 2002 09:49:32 +0000 (09:49 +0000)
committerNick Ing-Simmons <nik@tiuk.ti.com>
Mon, 10 Jun 2002 09:49:32 +0000 (09:49 +0000)
p4raw-id: //depot/perlio@17158

38 files changed:
Configure
MANIFEST
Porting/Glossary
Porting/config.sh
Porting/config_H
embed.fnc
embed.h
ext/Digest/MD5/t/files.t
ext/Encode/t/CJKT.t
ext/Encode/t/guess.t
ext/Storable/t/malice.t
ext/threads/threads.xs
hints/irix_6.sh
lib/Math/BigFloat.pm
lib/Math/BigInt.pm
lib/Math/BigInt/Calc.pm
lib/Math/BigInt/t/bare_mbf.t
lib/Math/BigInt/t/bare_mbi.t
lib/Math/BigInt/t/bigfltpm.inc
lib/Math/BigInt/t/bigfltpm.t
lib/Math/BigInt/t/bigintpm.inc
lib/Math/BigInt/t/bigintpm.t
lib/Math/BigInt/t/calling.t
lib/Math/BigInt/t/constant.t
lib/Math/BigInt/t/mbi_rand.t
lib/Math/BigInt/t/sub_mbf.t
lib/Math/BigInt/t/sub_mbi.t
lib/Math/BigInt/t/with_sub.t
lib/Net/Ping.pm
lib/Net/Ping/Changes [moved from lib/Net/Ping/CHANGES with 91% similarity]
lib/Net/Ping/README
pod/perldelta.pod
pod/perldiag.pod
pod/perlfunc.pod
proto.h
sv.c
sv.h
t/lib/Math/BigInt/BareCalc.pm

index c58e20a..523e2a2 100755 (executable)
--- a/Configure
+++ b/Configure
@@ -20,7 +20,7 @@
 
 # $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
index 8ed35fb..29b2e9d 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1306,7 +1306,7 @@ lib/Net/netent.t          See if Net::netent works
 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
index 09657fa..1ceb4dd 100644 (file)
@@ -57,7 +57,8 @@ api_revision (patchlevel.U):
        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.
@@ -65,7 +66,8 @@ api_revision (patchlevel.U):
        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.
@@ -771,7 +773,8 @@ d_Gconvert (d_gconvert.U):
        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
@@ -3065,9 +3068,11 @@ installstyle (installstyle.U):
        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".
 
@@ -3576,11 +3581,6 @@ perl5 (perl5.U):
        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.
@@ -4594,6 +4594,10 @@ xs_apiversion (xs_apiversion.U):
        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.
index fd089ce..78b434f 100644 (file)
@@ -8,7 +8,7 @@
 
 # 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 
 
@@ -63,7 +63,7 @@ ccsymbols='__alpha=1 __LANGUAGE_C__=1 __osf__=1 __unix__=1 _LONGLONG=1 _SYSTYPE_
 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'
index 3131326..5db9e3a 100644 (file)
@@ -17,7 +17,7 @@
 /*
  * 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 
  */
index 4a3cab4..fb0e213 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1242,7 +1242,7 @@ s      |int    |sv_2iuv_non_preserve   |SV *sv|I32 numtype
 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
 
diff --git a/embed.h b/embed.h
index 805fd0d..9f8605a 100644 (file)
--- a/embed.h
+++ b/embed.h
 #  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)
index 650121f..34ef9e0 100644 (file)
@@ -175,6 +175,7 @@ sub digest_file
     #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);
 
@@ -186,6 +187,7 @@ sub cat_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;
index 0c9bb7b..412d01e 100644 (file)
@@ -44,7 +44,7 @@ my %Charset =
 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;
@@ -70,7 +70,7 @@ for my $charset (sort keys %Charset){
     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;
@@ -85,7 +85,7 @@ for my $charset (sort keys %Charset){
     if (PerlIO::Layer->find('perlio')){
        binmode($src, ":utf8");
        $uni = join('', <$src>);
-    }else{ # ugh!
+    } else { # ugh!
        binmode($src);
        $uni = join('', <$src>);
        Encode::_utf8_on($uni);
@@ -99,6 +99,7 @@ for my $charset (sort keys %Charset){
 
     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")
index 563bc6f..fc71275 100644 (file)
@@ -48,6 +48,7 @@ my $jisx0208 = File::Spec->catfile(dirname(__FILE__), 'jisx0208.utf');
 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);
@@ -77,6 +78,7 @@ Encode::Guess->set_suspects(keys %CJKT);
 
 for my $name (keys %CJKT){
     open my $fh, $CJKT{$name} or die "$CJKT{$name}: $!";
+    binmode($fh, ":bytes");
     $utf8off = join('' => <$fh>);
     close $fh;
 
index 405fd3d..31cbbd1 100644 (file)
@@ -95,6 +95,7 @@ sub store_and_retrieve {
   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': $!";
 
@@ -258,6 +259,7 @@ sub slurp {
   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;
index e1f6c9a..59e3597 100755 (executable)
@@ -280,7 +280,7 @@ Perl_ithread_run(void * arg) {
                }
                PUTBACK;
                if (SvTRUE(ERRSV)) {
-                   Perl_warn(aTHX_ "Died:%" SVf,ERRSV);
+                   Perl_warn(aTHX_ "thread failed to start: %" SVf, ERRSV);
                }
                FREETMPS;
                LEAVE;
index f1c30ea..8b14e54 100644 (file)
@@ -13,9 +13,8 @@
 #    - 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
index ea78da5..c9624ba 100644 (file)
@@ -12,7 +12,7 @@ package Math::BigFloat;
 #   _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;
@@ -1715,7 +1715,6 @@ sub import
       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} };
@@ -1728,19 +1727,17 @@ sub import
     {
     # 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
       {
index a85a474..77f3343 100644 (file)
@@ -18,7 +18,7 @@ package Math::BigInt;
 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); 
@@ -1381,7 +1381,12 @@ sub bmod
       {
       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
       {
@@ -1398,7 +1403,7 @@ sub bmod
   $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
@@ -1414,8 +1419,14 @@ sub bmodinv_not_yet_implemented
          || $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.
 
@@ -1423,24 +1434,27 @@ sub bmodinv_not_yet_implemented
   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
@@ -1459,32 +1473,42 @@ sub bmodpow_not_yet_implemented
     # 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;
   }
 
 ###############################################################################
@@ -2277,15 +2301,18 @@ sub import
   $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
       {
@@ -2425,7 +2452,8 @@ sub _split
     $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 '';
@@ -2609,6 +2637,8 @@ Math::BigInt - Arbitrary size integer math package
                                # 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
@@ -2932,8 +2962,6 @@ numbers.
 
 =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
@@ -2942,8 +2970,6 @@ C<bgcd($num, $mod)==1>.
 
 =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
index a114d09..717361d 100644 (file)
@@ -8,7 +8,7 @@ require Exporter;
 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
 
@@ -108,6 +108,7 @@ BEGIN
   $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
 
@@ -413,7 +414,7 @@ sub _sub
   #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
@@ -1576,7 +1577,10 @@ sub _from_bin
   $x;
   }
 
-sub _modinv
+##############################################################################
+# special modulus functions
+
+sub _modinv1
   {
   # inverse modulus
   }
@@ -1584,6 +1588,43 @@ sub _modinv
 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;
   }
 
 ##############################################################################
index 8b682f9..4b9d3bc 100644 (file)
@@ -27,7 +27,7 @@ BEGIN
     }
   print "# INC = @INC\n";
 
-  plan tests => 1601;
+  plan tests => 1599;
   }
 
 use Math::BigFloat lib => 'BareCalc';
index 5899dfe..9a01dc6 100644 (file)
@@ -26,7 +26,7 @@ BEGIN
     }
   print "# INC = @INC\n";
 
-  plan tests => 2237;
+  plan tests => 2361;
   }
 
 use Math::BigInt lib => 'BareCalc';
index d455165..3f8ae6a 100644 (file)
@@ -384,7 +384,7 @@ abc:123.456:NaN
 #     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;
index 871365a..c5f6bca 100755 (executable)
@@ -26,7 +26,7 @@ BEGIN
     }
   print "# INC = @INC\n";
 
-  plan tests => 1601
+  plan tests => 1599
        + 2;            # own tests
   }
 
index 4d74a41..795e388 100644 (file)
@@ -217,6 +217,7 @@ $try .= '$a = $x->bpow($x);';
 $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);
@@ -249,6 +250,36 @@ ok ($x, -5);
 $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;";
@@ -504,6 +535,11 @@ $x = $class->new('-322056000'); ($x,$y) = $x->bdiv('-12882240');
 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);
@@ -578,6 +614,7 @@ __DATA__
 &%=
 100:3:1
 8:9:8
+-629:5033:4404
 &/=
 100:3:33
 -8:2:-4
@@ -788,6 +825,21 @@ E23:NaN
 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
@@ -1320,42 +1372,43 @@ inf:0:inf
 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
@@ -1457,6 +1510,8 @@ abc:1:abc:NaN
 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
index c14d441..9bc0341 100755 (executable)
@@ -10,7 +10,7 @@ BEGIN
   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;
index 8a0d2bb..b905385 100644 (file)
@@ -31,6 +31,11 @@ BEGIN
     }
   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;
index bdc73c7..2f14de2 100644 (file)
@@ -9,6 +9,11 @@ BEGIN
   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';
index b6d59ea..11c59cc 100644 (file)
@@ -7,7 +7,6 @@ my $count;
   
 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//;
@@ -41,12 +40,10 @@ for (my $i = 0; $i < $count; $i++)
   # 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())
     {
@@ -64,4 +61,3 @@ for (my $i = 0; $i < $count; $i++)
    unless ok ($ADB*$A+$two*$AMB-$AMB,$Bs);
   }
 
-
index 69a1ab9..206fe62 100755 (executable)
@@ -26,7 +26,7 @@ BEGIN
     }
   print "# INC = @INC\n"; 
   
-  plan tests => 1601
+  plan tests => 1599
     + 6;       # + our own tests
   }
 
index 95a0dae..dcd8645 100755 (executable)
@@ -26,8 +26,8 @@ BEGIN
     }
   print "# INC = @INC\n";
 
-  plan tests => 2237
-    + 5;       # +4 own tests
+  plan tests => 2361
+    + 5;       # +5 own tests
   }
 
 use Math::BigInt::Subclass;
index 07aa3c2..ad20ed8 100644 (file)
@@ -28,7 +28,7 @@ BEGIN
     }
   print "# INC = @INC\n";
 
-  plan tests => 1601
+  plan tests => 1599
        + 1;
   }
 
index 04cddc1..babe2b0 100644 (file)
@@ -1,13 +1,13 @@
 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 );
@@ -16,7 +16,7 @@ use POSIX qw(ECONNREFUSED);
 
 @ISA = qw(Exporter);
 @EXPORT = qw(pingecho);
-$VERSION = "2.18";
+$VERSION = "2.19";
 
 # Constants
 
@@ -25,6 +25,7 @@ $def_proto = "tcp";         # Default protocol to use for pinging
 $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:
@@ -163,6 +164,17 @@ sub bind
 }
 
 
+# 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
 
@@ -638,9 +650,10 @@ sub ping_udp
       $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;
@@ -672,7 +685,7 @@ __END__
 
 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
 
@@ -778,11 +791,22 @@ default) number of data bytes is 1 if the protocol is "udp" and 0
 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
similarity index 91%
rename from lib/Net/Ping/CHANGES
rename to lib/Net/Ping/Changes
index 0ac95cf..6677b52 100644 (file)
@@ -1,6 +1,13 @@
 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.
 
index e55e847..b3665ce 100644 (file)
@@ -1,7 +1,7 @@
 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;
@@ -102,10 +102,20 @@ DESCRIPTION
         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
index d14e208..09e138f 100644 (file)
@@ -566,6 +566,12 @@ is a NaN.  Previously the behaviour was unspecified.
 
 =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]
 
index 12fc7ac..6907866 100644 (file)
@@ -3586,6 +3586,10 @@ F<PERL_ENV_TABLES> (see L<perlvms>) so that the environ array isn't the
 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
index cbd58c8..b1d7ebd 100644 (file)
@@ -3112,9 +3112,8 @@ to have its own copy of the global.)  Examples:
     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
diff --git a/proto.h b/proto.h
index aafb94f..e201596 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1275,7 +1275,7 @@ STATIC int        S_sv_2iuv_non_preserve(pTHX_ SV *sv, I32 numtype);
 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
 
diff --git a/sv.c b/sv.c
index 18fdfc1..4f38159 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -8757,7 +8757,6 @@ Perl_ptr_table_store(pTHX_ PTR_TBL_t *tbl, void *oldv, void *newv)
     for (tblent = *otblent; tblent; i=0, tblent = tblent->next) {
        if (tblent->oldval == oldv) {
            tblent->newval = newv;
-           tbl->tbl_items++;
            return;
        }
     }
@@ -8859,10 +8858,10 @@ char *PL_watch_pvx;
 /* 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 = &param->proto_perl->Isv_no; /* just need SvREADONLY-ness */
 
     if (GvIO(gv) || GvFORM(gv)) {
         GvUNIQUE_off(gv); /* GvIOs cannot be shared. nor can GvFORMs */
@@ -8872,7 +8871,7 @@ S_gv_share(pTHX_ SV *sstr)
     }
     else {
         /* CvPADLISTs cannot be shared */
-        if (!CvXSUB(GvCV(gv))) {
+        if (!SvREADONLY(GvCV(gv)) && !CvXSUB(GvCV(gv))) {
             GvUNIQUE_off(gv);
         }
     }
@@ -9053,9 +9052,10 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
     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));
@@ -9758,6 +9758,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 #    endif     /* DEBUGGING */
 #endif         /* PERL_IMPLICIT_SYS */
     param->flags = flags;
+    param->proto_perl = proto_perl;
 
     /* arena roots */
     PL_xiv_arenaroot   = NULL;
diff --git a/sv.h b/sv.h
index 6f95c46..39441b4 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -1206,4 +1206,5 @@ Returns a pointer to the character buffer.
 struct clone_params {
   AV* stashes;
   UV  flags;
+  PerlInterpreter *proto_perl;
 };
index 7c56c4e..797957f 100644 (file)
@@ -14,10 +14,11 @@ $VERSION = '0.02';
 
 # 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
@@ -25,7 +26,6 @@ BEGIN
                /)
     {
     my $name  = "Math::BigInt::Calc::_$_";
-    no strict 'refs';
     *{"Math::BigInt::BareCalc::_$_"} = \&$name;
     }
   }