X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/7f764adcdf933d7a7b77989ac4bd7179ca460cf9..5a6c28370397ad3d5c138df5778833dc4b11c3be:/sv.c

diff --git a/sv.c b/sv.c
index 4df1224..5a554fe 100644
--- a/sv.c
+++ b/sv.c
@@ -3488,33 +3488,35 @@ Perl_sv_utf8_upgrade_flags_grow(pTHX_ SV *const sv, const I32 flags, STRLEN extr
 	U8 * s = (U8 *) SvPVX_const(sv);
 	U8 * e = (U8 *) SvEND(sv);
 	U8 *t = s;
-	STRLEN two_byte_count = 0;
+	STRLEN two_byte_count;
 	
-	if (flags & SV_FORCE_UTF8_UPGRADE) goto must_be_utf8;
-
-	/* See if really will need to convert to utf8.  We mustn't rely on our
-	 * incoming SV being well formed and having a trailing '\0', as certain
-	 * code in pp_formline can send us partially built SVs. */
-
-	if (is_utf8_invariant_string_loc(s, SvCUR(sv), (const U8 **) &t)) {
-
-            /* utf8 conversion not needed because all are invariants.  Mark as
-             * UTF-8 even if no variant - saves scanning loop */
-            SvUTF8_on(sv);
-            if (extra) SvGROW(sv, SvCUR(sv) + extra);
-            return SvCUR(sv);
-	}
+	if (flags & SV_FORCE_UTF8_UPGRADE) {
+            two_byte_count = 0;
+        }
+        else {
+            if (is_utf8_invariant_string_loc(s, SvCUR(sv), (const U8 **) &t)) {
 
-        two_byte_count = 1;
+                /* utf8 conversion not needed because all are invariants.  Mark
+                 * as UTF-8 even if no variant - saves scanning loop */
+                SvUTF8_on(sv);
+                if (extra) SvGROW(sv, SvCUR(sv) + extra);
+                return SvCUR(sv);
+            }
 
-      must_be_utf8:
+            /* Here, there is at least one variant, and t points to the first
+             * one */
+            two_byte_count = 1;
+        }
 
-	/* Here, the string should be converted to utf8, either because of an
-	 * input flag (two_byte_count = 0), or because a character that
-	 * requires 2 bytes was found (two_byte_count = 1).  t points either to
-	 * the beginning of the string (if we didn't examine anything), or to
-	 * the first variant.  In either case, everything from s to t - 1 will
-	 * occupy only 1 byte each on output.
+        /* Note that the incoming SV may not have a trailing '\0', as certain
+         * code in pp_formline can send us partially built SVs.
+         *
+	 * Here, the string should be converted to utf8, either because of an
+         * input flag (which causes two_byte_count to be set to 0), or because
+         * a character that requires 2 bytes was found (two_byte_count = 1).  t
+         * points either to the beginning of the string (if we didn't examine
+         * anything), or to the first variant.  In either case, everything from
+         * s to t - 1 will occupy only 1 byte each on output.
 	 *
 	 * There are two main ways to convert.  One is to create a new string
 	 * and go through the input starting from the beginning, appending each
@@ -13065,7 +13067,15 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
 	    if (float_need < width)
 		float_need = width;
 
-	    if (PL_efloatsize < float_need) {
+	    if (PL_efloatsize <= float_need) {
+                /* PL_efloatbuf should be at least 1 greater than
+                 * float_need to allow a trailing \0 to be returned by
+                 * snprintf().  If we need to grow, overgrow for the
+                 * benefit of future generations */
+                const STRLEN extra = 0x20;
+                if (float_need >= ((STRLEN)~0) - extra)
+                    croak_memory_wrap();
+                float_need += extra;
 		Safefree(PL_efloatbuf);
 		PL_efloatsize = float_need;
 		Newx(PL_efloatbuf, PL_efloatsize, char);
@@ -15397,6 +15407,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     init_constants();
     ptr_table_store(PL_ptr_table, &proto_perl->Isv_undef, &PL_sv_undef);
     ptr_table_store(PL_ptr_table, &proto_perl->Isv_no, &PL_sv_no);
+    ptr_table_store(PL_ptr_table, &proto_perl->Isv_zero, &PL_sv_zero);
     ptr_table_store(PL_ptr_table, &proto_perl->Isv_yes, &PL_sv_yes);
     ptr_table_store(PL_ptr_table, &proto_perl->Ipadname_const,
 		    &PL_padname_const);
@@ -15904,6 +15915,12 @@ Perl_init_constants(pTHX)
 				  |SVp_IOK|SVf_IOK|SVp_NOK|SVf_NOK
 				  |SVp_POK|SVf_POK;
 
+    SvANY(&PL_sv_zero)		= new_XPVNV();
+    SvREFCNT(&PL_sv_zero)	= SvREFCNT_IMMORTAL;
+    SvFLAGS(&PL_sv_zero)	= SVt_PVNV|SVf_READONLY|SVf_PROTECT
+				  |SVp_IOK|SVf_IOK|SVp_NOK|SVf_NOK
+				  |SVp_POK|SVf_POK;
+
     SvPV_set(&PL_sv_no, (char*)PL_No);
     SvCUR_set(&PL_sv_no, 0);
     SvLEN_set(&PL_sv_no, 0);
@@ -15916,6 +15933,12 @@ Perl_init_constants(pTHX)
     SvIV_set(&PL_sv_yes, 1);
     SvNV_set(&PL_sv_yes, 1);
 
+    SvPV_set(&PL_sv_zero, (char*)PL_Zero);
+    SvCUR_set(&PL_sv_zero, 1);
+    SvLEN_set(&PL_sv_zero, 0);
+    SvIV_set(&PL_sv_zero, 0);
+    SvNV_set(&PL_sv_zero, 0);
+
     PadnamePV(&PL_padname_const) = (char *)PL_No;
 }