This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
rename t/op/opt.t -> t/perf/optree.t
[perl5.git] / sv.c
diff --git a/sv.c b/sv.c
index 29c8a9a..9632b1a 100644 (file)
--- a/sv.c
+++ b/sv.c
     PERL_UNUSED_RESULT(Gconvert((NV)(nv), (int)ndig, 0, buffer))
 #endif
 
-#ifdef PERL_NEW_COPY_ON_WRITE
-#   ifndef SV_COW_THRESHOLD
+#ifndef SV_COW_THRESHOLD
 #    define SV_COW_THRESHOLD                    0   /* COW iff len > K */
-#   endif
-#   ifndef SV_COWBUF_THRESHOLD
+#endif
+#ifndef SV_COWBUF_THRESHOLD
 #    define SV_COWBUF_THRESHOLD                 1250 /* COW iff len > K */
-#   endif
-#   ifndef SV_COW_MAX_WASTE_THRESHOLD
+#endif
+#ifndef SV_COW_MAX_WASTE_THRESHOLD
 #    define SV_COW_MAX_WASTE_THRESHOLD          80   /* COW iff (len - cur) < K */
-#   endif
-#   ifndef SV_COWBUF_WASTE_THRESHOLD
+#endif
+#ifndef SV_COWBUF_WASTE_THRESHOLD
 #    define SV_COWBUF_WASTE_THRESHOLD           80   /* COW iff (len - cur) < K */
-#   endif
-#   ifndef SV_COW_MAX_WASTE_FACTOR_THRESHOLD
+#endif
+#ifndef SV_COW_MAX_WASTE_FACTOR_THRESHOLD
 #    define SV_COW_MAX_WASTE_FACTOR_THRESHOLD   2    /* COW iff len < (cur * K) */
-#   endif
-#   ifndef SV_COWBUF_WASTE_FACTOR_THRESHOLD
+#endif
+#ifndef SV_COWBUF_WASTE_FACTOR_THRESHOLD
 #    define SV_COWBUF_WASTE_FACTOR_THRESHOLD    2    /* COW iff len < (cur * K) */
-#   endif
 #endif
 /* Work around compiler warnings about unsigned >= THRESHOLD when thres-
    hold is 0. */
@@ -3973,8 +3971,8 @@ S_glob_assign_glob(pTHX_ SV *const dstr, SV *const sstr, const int dtype)
     return;
 }
 
-static void
-S_glob_assign_ref(pTHX_ SV *const dstr, SV *const sstr)
+void
+Perl_gv_setref(pTHX_ SV *const dstr, SV *const sstr)
 {
     SV * const sref = SvRV(sstr);
     SV *dref;
@@ -3983,7 +3981,7 @@ S_glob_assign_ref(pTHX_ SV *const dstr, SV *const sstr)
     U8 import_flag = 0;
     const U32 stype = SvTYPE(sref);
 
-    PERL_ARGS_ASSERT_GLOB_ASSIGN_REF;
+    PERL_ARGS_ASSERT_GV_SETREF;
 
     if (intro) {
        GvINTRO_off(dstr);      /* one-shot flag */
@@ -4170,7 +4168,7 @@ S_glob_assign_ref(pTHX_ SV *const dstr, SV *const sstr)
            Perl_magic_clearisa(aTHX_ NULL, mg);
        }
         else if (stype == SVt_PVIO) {
-            DEBUG_o(Perl_deb(aTHX_ "glob_assign_ref clearing PL_stashcache\n"));
+            DEBUG_o(Perl_deb(aTHX_ "gv_setref clearing PL_stashcache\n"));
             /* It's a cache. It will rebuild itself quite happily.
                It's a lot of effort to work out exactly which key (or keys)
                might be invalidated by the creation of the this file handle.
@@ -4429,7 +4427,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, SV* sstr, const I32 flags)
 
        if (dtype >= SVt_PV) {
            if (isGV_with_GP(dstr)) {
-               glob_assign_ref(dstr, sstr);
+               gv_setref(dstr, sstr);
                return;
            }
            if (SvPVX_const(dstr)) {
@@ -5387,8 +5385,14 @@ Handles 'get' magic, but not 'set' magic.  See C<sv_catpvn_mg>.
 =for apidoc sv_catpvn_flags
 
 Concatenates the string onto the end of the string which is in the SV.  The
-C<len> indicates number of bytes to copy.  If the SV has the UTF-8
-status set, then the bytes appended should be valid UTF-8.
+C<len> indicates number of bytes to copy.
+
+By default, the string appended is assumed to be valid UTF-8 if the SV has
+the UTF-8 status set, and a string of bytes otherwise.  One can force the
+appended string to be interpreted as UTF-8 by supplying the C<SV_CATUTF8>
+flag, and as bytes by supplying the C<SV_CATBYTES> flag; the SV or the
+string appended will be upgraded to UTF-8 if necessary.
+
 If C<flags> has the C<SV_SMAGIC> bit set, will
 C<mg_set> on C<dsv> afterwards if appropriate.
 C<sv_catpvn> and C<sv_catpvn_nomg> are implemented
@@ -5470,14 +5474,12 @@ Perl_sv_catsv_flags(pTHX_ SV *const dsv, SV *const ssv, const I32 flags)
     if (ssv) {
        STRLEN slen;
        const char *spv = SvPV_flags_const(ssv, slen, flags);
-       if (spv) {
-            if (flags & SV_GMAGIC)
+        if (flags & SV_GMAGIC)
                 SvGETMAGIC(dsv);
-           sv_catpvn_flags(dsv, spv, slen,
+        sv_catpvn_flags(dsv, spv, slen,
                            DO_UTF8(ssv) ? SV_CATUTF8 : SV_CATBYTES);
-            if (flags & SV_SMAGIC)
+        if (flags & SV_SMAGIC)
                 SvSETMAGIC(dsv);
-        }
     }
 }
 
@@ -8906,8 +8908,10 @@ Perl_sv_dec_nomg(pTHX_ SV *const sv)
  */
 #define PUSH_EXTEND_MORTAL__SV_C(AnSv) \
     STMT_START {      \
-       EXTEND_MORTAL(1); \
-       PL_tmps_stack[++PL_tmps_ix] = (AnSv); \
+       SSize_t ix = ++PL_tmps_ix;              \
+       if (UNLIKELY(ix >= PL_tmps_max))        \
+           ix = tmps_grow_p(ix);                       \
+       PL_tmps_stack[ix] = (AnSv); \
     } STMT_END
 
 /*
@@ -9029,7 +9033,7 @@ Perl_sv_2mortal(pTHX_ SV *const sv)
 {
     dVAR;
     if (!sv)
-       return NULL;
+       return sv;
     if (SvIMMORTAL(sv))
        return sv;
     PUSH_EXTEND_MORTAL__SV_C(sv);
@@ -10714,12 +10718,16 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
 #if LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LITTLE_ENDIAN || \
     LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BIG_ENDIAN
 #  define LONGDOUBLE_DOUBLEDOUBLE
-#  define DOUBLEDOUBLE_MAXBITS 1028
+/* The first double can be as large as 2**1023, or '1' x '0' x 1023.
+ * The second double can be as small as 2**-1074, or '0' x 1073 . '1'.
+ * The sum of them can be '1' . '0' x 2096 . '1', with implied radix point
+ * after the first 1023 zero bits. */
+#  define DOUBLEDOUBLE_MAXBITS 2098
 #endif
 
 /* vhex will contain the values (0..15) of the hex digits ("nybbles"
  * of 4 bits); 1 for the implicit 1, and the mantissa bits, four bits
- * per xdigit. */
+ * per xdigit.  For the double-double case, this can be rather many. */
 #ifdef LONGDOUBLE_DOUBLEDOUBLE
 #  define VHEX_SIZE (1+DOUBLEDOUBLE_MAXBITS/4)
 #else
@@ -11960,13 +11968,10 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                      * Since each double has their own exponent, the
                      * doubles may float (haha) rather far from each
                      * other, and the number of required bits is much
-                     * larger, up to total of 1028 bits.  (NOTE: this
-                     * is not actually implemented properly yet,
-                     * we are using just the first double, see
-                     * S_hextract() for details.  But let's prepare
-                     * for the future.) */
-
-                    /* 2 hexdigits for each byte. */ 
+                     * larger, up to total of DOUBLEDOUBLE_MAXBITS bits.
+                     * See the definition of DOUBLEDOUBLE_MAXBITS.
+                     *
+                     * Need 2 hexdigits for each byte. */
                     need += (DOUBLEDOUBLE_MAXBITS/8 + 1) * 2;
                     /* the size for the exponent already added */
 #endif
@@ -14576,6 +14581,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_DBsingle                = sv_dup(proto_perl->IDBsingle, param);
     PL_DBtrace         = sv_dup(proto_perl->IDBtrace, param);
     PL_DBsignal                = sv_dup(proto_perl->IDBsignal, param);
+    Copy(proto_perl->IDBcontrol, PL_DBcontrol, DBVARMG_COUNT, IV);
 
     /* symbol tables */
     PL_defstash                = hv_dup_inc(proto_perl->Idefstash, param);
@@ -15739,17 +15745,21 @@ Perl_report_uninit(pTHX_ const SV *uninit_sv)
 {
     if (PL_op) {
        SV* varname = NULL;
+       const char *desc;
        if (uninit_sv && PL_curpad) {
            varname = find_uninit_var(PL_op, uninit_sv,0);
            if (varname)
                sv_insert(varname, 0, 0, " ", 1);
        }
+       desc = PL_op->op_type == OP_STRINGIFY && PL_op->op_folded
+               ? "join or string"
+               : OP_DESC(PL_op);
         /* PL_warn_uninit_sv is constant */
         GCC_DIAG_IGNORE(-Wformat-nonliteral);
        /* diag_listed_as: Use of uninitialized value%s */
        Perl_warner(aTHX_ packWARN(WARN_UNINITIALIZED), PL_warn_uninit_sv,
                SVfARG(varname ? varname : &PL_sv_no),
-               " in ", OP_DESC(PL_op));
+               " in ", desc);
         GCC_DIAG_RESTORE;
     }
     else {