[perl #92706] In PerlIO::Scalar::seek, don’t assume SvPOKp

Otherwise we get assertion failures.

In fact, since seeking might be just for reading, we can’t coerce and
SvGROW either.

In fact, since the scalar might be modified between seek and write,
there is no *point* in SvGROW during seek, even for SvPOK scalars.

PerlIO::scalar assumes in too many places that the scalar it is using
is its own private scalar that nothing else can modify.  Nothing could
be farther from the truth.

This commit moves the zero-fill that usually happens when seeking past
the end from seek to write.  During a write, if the current position
is past the end of the string, the intervening bytes are zero-filled
at that point, since the seek hasn’t done it.

2 files changed, 21 insertions, 20 deletions

diff --git a/ext/PerlIO-scalar/scalar.xs b/ext/PerlIO-scalar/scalar.xs
index e0f75acf1a..970091a2cb 100644
--- a/ext/PerlIO-scalar/scalar.xs
+++ b/ext/PerlIO-scalar/scalar.xs
@@ -93,11 +93,6 @@ IV
 PerlIOScalar_seek(pTHX_ PerlIO * f, Off_t offset, int whence)
 {
     PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
-    STRLEN oldcur;
-    STRLEN newlen;
-
-    SvGETMAGIC(s->var);
-    oldcur = SvCUR(s->var);
 
     switch (whence) {
     case SEEK_SET:
@@ -107,8 +102,12 @@ PerlIOScalar_seek(pTHX_ PerlIO * f, Off_t offset, int whence)
 	s->posn = offset + s->posn;
 	break;
     case SEEK_END:
-	s->posn = offset + SvCUR(s->var);
+      {
+	STRLEN oldcur;
+	(void)SvPV(s->var, oldcur);
+	s->posn = offset + oldcur;
 	break;
+      }
     }
     if (s->posn < 0) {
         if (ckWARN(WARN_LAYER))
@@ -116,17 +115,6 @@ PerlIOScalar_seek(pTHX_ PerlIO * f, Off_t offset, int whence)
 	SETERRNO(EINVAL, SS_IVCHAN);
 	return -1;
     }
-    newlen = (STRLEN) s->posn;
-    if (newlen > oldcur) {
-	(void) SvGROW(s->var, newlen);
-	Zero(SvPVX(s->var) + oldcur, newlen - oldcur, char);
-	/* No SvCUR_set(), though.  This is just a seek, not a write. */
-    }
-    else if (!SvPVX(s->var)) {
-	/* ensure there's always a character buffer */
-	(void)SvGROW(s->var,1);
-    }
-    SvPOK_on(s->var);
     return 0;
 }
 
@@ -182,7 +170,12 @@ PerlIOScalar_write(pTHX_ PerlIO * f, const void *vbuf, Size_t count)
 	    s->posn = offset + count;
 	}
 	else {
-	    if ((s->posn + count) > SvCUR(sv))
+	    STRLEN const cur = SvCUR(sv);
+	    if (s->posn > cur) {
+		dst = SvGROW(sv, (STRLEN)s->posn + count);
+		Zero(SvPVX(sv) + cur, (STRLEN)s->posn - cur, char);
+	    }
+	    else if ((s->posn + count) > cur)
 		dst = SvGROW(sv, (STRLEN)s->posn + count);
 	    else
 		dst = SvPVX(sv);
diff --git a/ext/PerlIO-scalar/t/scalar.t b/ext/PerlIO-scalar/t/scalar.t
index ed1ae69dbb..4a026a4ec8 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 => 71;
+use Test::More tests => 73;
 
 my $fh;
 my $var = "aaa\n";
@@ -255,7 +255,7 @@ EOF
     print($fh 'DEF');
     $s .= ':P';
     ok(close($fh), 'close tied scalar - write');
-    is($s, ':F:S():O:F:S(ABC):P:F:SK:F:S(DEF):P', 'tied actions - write');
+    is($s, ':F:S():O:F:S(ABC):P:SK:F:S(DEF):P', 'tied actions - write');
     is($x, 'DEF', 'new value preserved');
 
     $x = 'GHI';
@@ -292,3 +292,11 @@ EOF
     print $handel "the COW with the crumpled horn";
     is $bovid, "the COW with the crumpled horn", 'writing to COW scalars';
 }
+
+# [perl #92706]
+{
+    open my $fh, "<", \(my $f=*f); seek $fh, 2,1;
+    pass 'seeking on a glob copy';
+    open my $fh, "<", \(my $f=*f); seek $fh, -2,2;
+    pass 'seeking on a glob copy from the end';
+}