Import perl-5.20.2

9 files changed, 73 insertions, 20 deletions

diff --git a/gnu/usr.bin/perl/ext/Errno/Errno_pm.PL b/gnu/usr.bin/perl/ext/Errno/Errno_pm.PL
index 55ad01a0c4f..cfab893b495 100644
--- a/gnu/usr.bin/perl/ext/Errno/Errno_pm.PL
+++ b/gnu/usr.bin/perl/ext/Errno/Errno_pm.PL
@@ -2,7 +2,7 @@ use ExtUtils::MakeMaker;
 use Config;
 use strict;
 
-our $VERSION = "1.20_03";
+our $VERSION = "1.20_05";
 
 my %err = ();
 
@@ -249,9 +249,9 @@ sub write_errno_pm {
 	    my($name,$expr);
 	    next unless ($name, $expr) = /"(.*?)"\s*\[\s*\[\s*(.*?)\s*\]\s*\]/;
 	    next if $name eq $expr;
-	    $expr =~ s/\(?\(\s*[a-z_]\w*\s*\)([^\)]*)\)?/$1/i; # ((type)0xcafebabe) at alia
-	    $expr =~ s/((?:0x)?[0-9a-fA-F]+)[luLU]+\b/$1/g; # 2147483647L et alia
-	    next if $expr =~ m/^[a-zA-Z]+$/; # skip some Win32 functions
+	    $expr =~ s/\(?\(\s*[a-z_]\w*\s*\)\(?([^\)]+)\)?\)?/$1/i; # ((type)0xcafebabe) at alia
+	    $expr =~ s/\b((?:0x)?[0-9a-f]+)[LU]+\b/$1/gi; # 2147483647L et alia
+	    next if $expr =~ m/\b[a-z_]\w*\b/i; # skip expressions containing function names etc
 	    if($expr =~ m/^0[xX]/) {
 		$err{$name} = hex $expr;
 	    }
diff --git a/gnu/usr.bin/perl/ext/PerlIO-scalar/scalar.pm b/gnu/usr.bin/perl/ext/PerlIO-scalar/scalar.pm
index 7581f84d6e6..7e93f6da562 100644
--- a/gnu/usr.bin/perl/ext/PerlIO-scalar/scalar.pm
+++ b/gnu/usr.bin/perl/ext/PerlIO-scalar/scalar.pm
@@ -1,5 +1,5 @@
 package PerlIO::scalar;
-our $VERSION = '0.18';
+our $VERSION = '0.18_01';
 require XSLoader;
 XSLoader::load();
 1;
diff --git a/gnu/usr.bin/perl/ext/PerlIO-scalar/scalar.xs b/gnu/usr.bin/perl/ext/PerlIO-scalar/scalar.xs
index 8d217c95b55..5c5eccf812a 100644
--- a/gnu/usr.bin/perl/ext/PerlIO-scalar/scalar.xs
+++ b/gnu/usr.bin/perl/ext/PerlIO-scalar/scalar.xs
@@ -103,28 +103,33 @@ IV
 PerlIOScalar_seek(pTHX_ PerlIO * f, Off_t offset, int whence)
 {
     PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
+    Off_t new_posn;
 
     switch (whence) {
     case SEEK_SET:
-	s->posn = offset;
+	new_posn = offset;
 	break;
     case SEEK_CUR:
-	s->posn = offset + s->posn;
+	new_posn = offset + s->posn;
 	break;
     case SEEK_END:
       {
 	STRLEN oldcur;
 	(void)SvPV(s->var, oldcur);
-	s->posn = offset + oldcur;
+	new_posn = offset + oldcur;
 	break;
       }
+    default:
+        SETERRNO(EINVAL, SS_IVCHAN);
+        return -1;
     }
-    if (s->posn < 0) {
+    if (new_posn < 0) {
         if (ckWARN(WARN_LAYER))
 	    Perl_warner(aTHX_ packWARN(WARN_LAYER), "Offset outside string");
 	SETERRNO(EINVAL, SS_IVCHAN);
 	return -1;
     }
+    s->posn = new_posn;
     return 0;
 }
 
@@ -151,7 +156,7 @@ PerlIOScalar_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 	SV *sv = s->var;
 	char *p;
 	STRLEN len;
-	I32 got;
+        STRLEN got;
 	p = SvPV(sv, len);
 	if (SvUTF8(sv)) {
 	    if (sv_utf8_downgrade(sv, TRUE)) {
@@ -164,9 +169,15 @@ PerlIOScalar_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 	        return -1;
 	    }
 	}
-	got = len - (STRLEN)(s->posn);
-	if (got <= 0)
+        /* I assume that Off_t is at least as large as len (which 
+         * seems safe) and that the size of the buffer in our SV is
+         * always less than half the size of the address space
+         */
+        assert(sizeof(Off_t) >= sizeof(len));
+        assert((Off_t)len >= 0);
+        if ((Off_t)len <= s->posn)
 	    return 0;
+	got = len - (STRLEN)(s->posn);
 	if ((STRLEN)got > (STRLEN)count)
 	    got = (STRLEN)count;
 	Copy(p + (STRLEN)(s->posn), vbuf, got, STDCHAR);
@@ -265,7 +276,7 @@ PerlIOScalar_get_cnt(pTHX_ PerlIO * f)
 	PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
 	STRLEN len;
 	(void)SvPV(s->var,len);
-	if (len > (STRLEN) s->posn)
+	if ((Off_t)len > s->posn)
 	    return len - (STRLEN)s->posn;
 	else
 	    return 0;
diff --git a/gnu/usr.bin/perl/ext/PerlIO-scalar/t/scalar.t b/gnu/usr.bin/perl/ext/PerlIO-scalar/t/scalar.t
index 9bc1abe16cf..f4cfbefaf96 100755
--- a/gnu/usr.bin/perl/ext/PerlIO-scalar/t/scalar.t
+++ b/gnu/usr.bin/perl/ext/PerlIO-scalar/t/scalar.t
@@ -16,7 +16,7 @@ use Fcntl qw(SEEK_SET SEEK_CUR SEEK_END); # Not 0, 1, 2 everywhere.
 
 $| = 1;
 
-use Test::More tests => 114;
+use Test::More tests => 120;
 
 my $fh;
 my $var = "aaa\n";
@@ -491,3 +491,22 @@ my $byte_warning = "Strings with code points over 0xFF may not be mapped into in
     print $refh "boo\n";
     is $x, $as_string."boo\n", 'string gets appended to ref';
 }
+
+SKIP:
+{ # [perl #123443]
+    skip "Can't seek over 4GB with a small off_t", 4
+      if $Config::Config{lseeksize} < 8;
+    my $buf0 = "hello";
+    open my $fh, "<", \$buf0 or die $!;
+    ok(seek($fh, 2**32, SEEK_SET), "seek to a large position");
+    is(read($fh, my $tmp, 1), 0, "read from a large offset");
+    is($tmp, "", "should have read nothing");
+    ok(eof($fh), "fh should be eof");
+}
+
+{
+    my $buf0 = "hello";
+    open my $fh, "<", \$buf0 or die $!;
+    ok(!seek($fh, -10, SEEK_CUR), "seek to negative position");
+    is(tell($fh), 0, "shouldn't change the position");
+}
diff --git a/gnu/usr.bin/perl/ext/VMS-DCLsym/DCLsym.pm b/gnu/usr.bin/perl/ext/VMS-DCLsym/DCLsym.pm
index 65482234356..f299c43b58b 100644
--- a/gnu/usr.bin/perl/ext/VMS-DCLsym/DCLsym.pm
+++ b/gnu/usr.bin/perl/ext/VMS-DCLsym/DCLsym.pm
@@ -7,7 +7,7 @@ use strict;
 
 # Package globals
 @ISA = ( 'DynaLoader' );
-$VERSION = '1.05';
+$VERSION = '1.05_01';
 my(%Locsyms) = ( ':ID' => 'LOCAL' );
 my(%Gblsyms) = ( ':ID' => 'GLOBAL');
 my $DoCache = 1;
@@ -265,7 +265,7 @@ Charles Bailey  bailey@newman.upenn.edu
 
 =head1 VERSION
 
-1.05  12-Feb-2011
+1.05_01  16-Jun-2013
 
 =head1 BUGS
 
diff --git a/gnu/usr.bin/perl/ext/VMS-Stdio/Stdio.pm b/gnu/usr.bin/perl/ext/VMS-Stdio/Stdio.pm
index 1b8a4f7e2da..4d05994279e 100644
--- a/gnu/usr.bin/perl/ext/VMS-Stdio/Stdio.pm
+++ b/gnu/usr.bin/perl/ext/VMS-Stdio/Stdio.pm
@@ -13,7 +13,7 @@ use Carp '&croak';
 use DynaLoader ();
 use Exporter ();
  
-$VERSION = '2.4';
+$VERSION = '2.41';
 @ISA = qw( Exporter DynaLoader IO::File );
 @EXPORT = qw( &O_APPEND &O_CREAT &O_EXCL  &O_NDELAY &O_NOWAIT
               &O_RDONLY &O_RDWR  &O_TRUNC &O_WRONLY );
diff --git a/gnu/usr.bin/perl/ext/XS-APItest/t/clone-with-stack.t b/gnu/usr.bin/perl/ext/XS-APItest/t/clone-with-stack.t
index 7a0cd294790..3238e9f3c99 100644
--- a/gnu/usr.bin/perl/ext/XS-APItest/t/clone-with-stack.t
+++ b/gnu/usr.bin/perl/ext/XS-APItest/t/clone-with-stack.t
@@ -17,7 +17,7 @@ if (not $Config{'useithreads'}) {
     skip_all("clone_with_stack requires threads");
 }
 
-plan(4);
+plan(5);
 
 fresh_perl_is( <<'----', <<'====', undef, "minimal clone_with_stack" );
 use XS::APItest;
@@ -65,3 +65,26 @@ X-Y-0:1:2:3:4-Z
 ====
 
 }
+
+{
+    fresh_perl_is( <<'----', <<'====', undef, "with localised stuff" );
+use XS::APItest;
+$s = "outer";
+$a[0] = "anterior";
+$h{k} = "hale";
+{
+    local $s = "inner";
+    local $a[0] = 'posterior';
+    local $h{k} = "halt";
+    clone_with_stack();
+}
+print "scl: $s\n";
+print "ary: $a[0]\n";
+print "hsh: $h{k}\n";
+----
+scl: outer
+ary: anterior
+hsh: hale
+====
+
+}
diff --git a/gnu/usr.bin/perl/ext/attributes/attributes.pm b/gnu/usr.bin/perl/ext/attributes/attributes.pm
index 7c3c0b0247d..ebca2146085 100644
--- a/gnu/usr.bin/perl/ext/attributes/attributes.pm
+++ b/gnu/usr.bin/perl/ext/attributes/attributes.pm
@@ -1,6 +1,6 @@
 package attributes;
 
-our $VERSION = 0.22;
+our $VERSION = 0.23;
 
 @EXPORT_OK = qw(get reftype);
 @EXPORT = ();
diff --git a/gnu/usr.bin/perl/ext/attributes/attributes.xs b/gnu/usr.bin/perl/ext/attributes/attributes.xs
index dbb644d066e..6b36812b13d 100644
--- a/gnu/usr.bin/perl/ext/attributes/attributes.xs
+++ b/gnu/usr.bin/perl/ext/attributes/attributes.xs
@@ -97,7 +97,7 @@ modify_SV_attributes(pTHX_ SV *sv, SV **retlist, SV **attrlist, int numattrs)
 	    }
 	    break;
 	default:
-	    if (memEQs(name, 6, "shared")) {
+	    if (memEQs(name, len, "shared")) {
 			if (negated)
 			    Perl_croak(aTHX_ "A variable may not be unshared");
 			SvSHARE(sv);