This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
S_scan_const: Make sure room for NUL in dest
authorKarl Williamson <khw@cpan.org>
Sat, 27 Apr 2019 20:30:02 +0000 (14:30 -0600)
committerKarl Williamson <khw@cpan.org>
Fri, 3 May 2019 16:58:50 +0000 (10:58 -0600)
At the end of a constant, we add a trailing NUL.  This commit makes sure
there's room for it.  But the code earlier was supposed to have already
made enough space, so its a bug if there isn't enough space.  So on
DEBUGGING builds, we panic, as we've done before.  But otherwise we can
continue on with no actual harm having been done.

toke.c

diff --git a/toke.c b/toke.c
index b409628..68eea0c 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -4109,12 +4109,31 @@ S_scan_const(pTHX_ char *start)
        }
     } /* while loop to process each character */
 
+    {
+        const STRLEN off = d - SvPVX(sv);
+
+        /* See if room for the terminating NUL */
+        if (UNLIKELY(off >= SvLEN(sv))) {
+
+#ifndef DEBUGGING
+
+            if (off > SvLEN(sv))
+#endif
+                Perl_croak(aTHX_ "panic: constant overflowed allocated space,"
+                        " %" UVuf " >= %" UVuf, (UV)off, (UV)SvLEN(sv));
+
+            /* Whew!  Here we don't have room for the terminating NUL, but
+             * everything else so far has fit.  It's not too late to grow
+             * to fit the NUL and continue on.  But it is a bug, as the code
+             * above was supposed to have made room for this, so under
+             * DEBUGGING builds, we panic anyway.  */
+            d = off + SvGROW(sv, off + 1);
+        }
+    }
+
     /* terminate the string and set up the sv */
     *d = '\0';
     SvCUR_set(sv, d - SvPVX_const(sv));
-    if (SvCUR(sv) >= SvLEN(sv))
-       Perl_croak(aTHX_ "panic: constant overflowed allocated space, %" UVuf
-                  " >= %" UVuf, (UV)SvCUR(sv), (UV)SvLEN(sv));
 
     SvPOK_on(sv);
     if (d_is_utf8) {