don't allow a negative file position on a PerlIO::scalar handle

previosly seek() would produce an error, but would still make the\
file position negative.

2 files changed, 17 insertions, 5 deletions

diff --git a/ext/PerlIO-scalar/scalar.xs b/ext/PerlIO-scalar/scalar.xs
index f130c0c318..9ccded57e4 100644
--- a/ext/PerlIO-scalar/scalar.xs
+++ b/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;
 }
 
diff --git a/ext/PerlIO-scalar/t/scalar.t b/ext/PerlIO-scalar/t/scalar.t
index 547ecea100..f1156d67ec 100644
--- a/ext/PerlIO-scalar/t/scalar.t
+++ b/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 => 118;
+use Test::More tests => 120;
 
 my $fh;
 my $var = "aaa\n";
@@ -500,3 +500,10 @@ my $byte_warning = "Strings with code points over 0xFF may not be mapped into in
     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");
+}