This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
add PL_sv_zero
[perl5.git] / sv.c
diff --git a/sv.c b/sv.c
index 4df1224..5a554fe 100644 (file)
--- 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;
        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
         *
         * 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 (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);
                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);
     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);
     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;
 
                                  |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);
     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);
 
     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;
 }
 
     PadnamePV(&PL_padname_const) = (char *)PL_No;
 }