This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
toke.c: Fix too-small SvGROW()
authorKarl Williamson <khw@cpan.org>
Wed, 28 Dec 2016 02:37:33 +0000 (19:37 -0700)
committerKarl Williamson <khw@cpan.org>
Tue, 3 Jan 2017 04:46:41 +0000 (21:46 -0700)
This might be a bug on EBCDIC, but not ASCII platforms.  The code forgot
that SvGROW takes a total size, and not an incremental size.  So, this
is most likely a no-op, but I believe there are no cases on ASCII
platforms where this actually needs to grow, and on EBCDIC, it would
only be very large, way above Unicode, code points.  Grows in later
iterations of the loop would recover to grow to the correct size, unless
this EBCDIC escape sequence was the final thing there.

toke.c

diff --git a/toke.c b/toke.c
index 0b9b8fc..7836710 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -3410,6 +3410,11 @@ S_scan_const(pTHX_ char *start)
                                                   /* Above-latin1 in string
                                                    * implies no encoding */
                                                   |SV_UTF8_NO_ENCODING,
+                                           /* Since we're having to grow here,
+                                            * make sure we have enough room for
+                                            * this escape and a NUL, so the
+                                            * code immediately below won't have
+                                            * to actually grow again */
                                        UVCHR_SKIP(uv) + (STRLEN)(send - s) + 1);
                        d = SvPVX(sv) + SvCUR(sv);
                        has_utf8 = TRUE;
@@ -3422,8 +3427,10 @@ S_scan_const(pTHX_ char *start)
                         * EBCDIC where \x{40000000} contains 12 bytes, and the
                         * UTF-8 for it contains 14.  And, we have to allow for
                         * a trailing NUL.  It probably can't happen on ASCII
-                        * platforms, but be safe */
-                        const STRLEN needed = d - SvPVX(sv) + UVCHR_SKIP(uv)
+                        * platforms, but be safe.  See Note on sizing above. */
+                        const STRLEN needed = d - SvPVX(sv)
+                                            + UVCHR_SKIP(uv)
+                                            + (send - s)
                                             + 1;
                         if (UNLIKELY(needed > SvLEN(sv))) {
                             SvCUR_set(sv, d - SvPVX_const(sv));