This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
return inode numbers as strings where necessary
[perl5.git] / sv.c
diff --git a/sv.c b/sv.c
index 6dcd99a..c1a33fb 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1645,6 +1645,7 @@ Perl_sv_setiv(pTHX_ SV *const sv, const IV i)
     case SVt_PVGV:
        if (!isGV_with_GP(sv))
            break;
+        /* FALLTHROUGH */
     case SVt_PVAV:
     case SVt_PVHV:
     case SVt_PVCV:
@@ -1758,6 +1759,7 @@ Perl_sv_setnv(pTHX_ SV *const sv, const NV num)
     case SVt_PVGV:
        if (!isGV_with_GP(sv))
            break;
+        /* FALLTHROUGH */
     case SVt_PVAV:
     case SVt_PVHV:
     case SVt_PVCV:
@@ -3139,7 +3141,7 @@ Perl_sv_2pv_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags)
                     DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
                     STORE_LC_NUMERIC_SET_TO_NEEDED();
 
-                    local_radix = PL_numeric_local && PL_numeric_radix_sv;
+                    local_radix = PL_numeric_underlying && PL_numeric_radix_sv;
                     if (local_radix && SvCUR(PL_numeric_radix_sv) > 1) {
                         size += SvCUR(PL_numeric_radix_sv) - 1;
                         s = SvGROW_mutable(sv, size);
@@ -3917,15 +3919,14 @@ S_glob_assign_glob(pTHX_ SV *const dstr, SV *const sstr, const int dtype)
        glob to begin with. */
     if(dtype == SVt_PVGV) {
         const char * const name = GvNAME((const GV *)dstr);
-        if(
-            strEQ(name,"ISA")
+        const STRLEN len = GvNAMELEN(dstr);
+        if(memEQs(name, len, "ISA")
          /* The stash may have been detached from the symbol table, so
             check its name. */
          && GvSTASH(dstr) && HvENAME(GvSTASH(dstr))
         )
             mro_changes = 2;
         else {
-            const STRLEN len = GvNAMELEN(dstr);
             if ((len > 1 && name[len-2] == ':' && name[len-1] == ':')
              || (len == 1 && name[0] == ':')) {
                 mro_changes = 3;
@@ -4138,7 +4139,7 @@ Perl_gv_setref(pTHX_ SV *const dstr, SV *const sstr)
        }
        else if (
            stype == SVt_PVAV && sref != dref
-        && strEQ(GvNAME((GV*)dstr), "ISA")
+        && memEQs(GvNAME((GV*)dstr), GvNAMELEN((GV*)dstr), "ISA")
         /* The stash may have been detached from the symbol table, so
            check its name before doing anything. */
         && GvSTASH(dstr) && HvENAME(GvSTASH(dstr))
@@ -4694,11 +4695,13 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, SV* sstr, const I32 flags)
             ) {
             /* Either it's a shared hash key, or it's suitable for
                copy-on-write.  */
+#ifdef DEBUGGING
             if (DEBUG_C_TEST) {
                 PerlIO_printf(Perl_debug_log, "Copy on write: sstr --> dstr\n");
                 sv_dump(sstr);
                 sv_dump(dstr);
             }
+#endif
 #ifdef PERL_ANY_COW
             if (!(sflags & SVf_IsCOW)) {
                     SvIsCOW_on(sstr);
@@ -4872,7 +4875,7 @@ Perl_sv_setsv_cow(pTHX_ SV *dstr, SV *sstr)
 #endif
 
     PERL_ARGS_ASSERT_SV_SETSV_COW;
-
+#ifdef DEBUGGING
     if (DEBUG_C_TEST) {
        PerlIO_printf(Perl_debug_log, "Fast copy on write: %p -> %p\n",
                      (void*)sstr, (void*)dstr);
@@ -4880,7 +4883,7 @@ Perl_sv_setsv_cow(pTHX_ SV *dstr, SV *sstr)
        if (dstr)
                    sv_dump(dstr);
     }
-
+#endif
     if (dstr) {
        if (SvTHINKFIRST(dstr))
            sv_force_normal_flags(dstr, SV_COW_DROP_PV);
@@ -4927,9 +4930,10 @@ Perl_sv_setsv_cow(pTHX_ SV *dstr, SV *sstr)
        SvUTF8_on(dstr);
     SvLEN_set(dstr, len);
     SvCUR_set(dstr, cur);
-    if (DEBUG_C_TEST) {
-       sv_dump(dstr);
-    }
+#ifdef DEBUGGING
+    if (DEBUG_C_TEST)
+               sv_dump(dstr);
+#endif
     return dstr;
 }
 #endif
@@ -5215,12 +5219,14 @@ S_sv_uncow(pTHX_ SV * const sv, const U32 flags)
        const STRLEN len = SvLEN(sv);
        const STRLEN cur = SvCUR(sv);
 
+#ifdef DEBUGGING
         if (DEBUG_C_TEST) {
                 PerlIO_printf(Perl_debug_log,
                               "Copy on write: Force normal %ld\n",
                               (long) flags);
                 sv_dump(sv);
         }
+#endif
         SvIsCOW_off(sv);
 # ifdef PERL_COPY_ON_WRITE
        if (len) {
@@ -5260,9 +5266,10 @@ S_sv_uncow(pTHX_ SV * const sv, const U32 flags)
            } else {
                unshare_hek(SvSHARED_HEK_FROM_PV(pvx));
            }
-            if (DEBUG_C_TEST) {
+#ifdef DEBUGGING
+            if (DEBUG_C_TEST)
                 sv_dump(sv);
-            }
+#endif
        }
 #else
            const char * const pvx = SvPVX_const(sv);
@@ -6805,10 +6812,12 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
                     && !(IoFLAGS(sv) & IOf_FAKE_DIRP)))
            {
                if (SvIsCOW(sv)) {
+#ifdef DEBUGGING
                    if (DEBUG_C_TEST) {
                        PerlIO_printf(Perl_debug_log, "Copy on write: clear\n");
                        sv_dump(sv);
                    }
+#endif
                    if (SvLEN(sv)) {
                        if (CowREFCNT(sv)) {
                            sv_buf_to_rw(sv);
@@ -9002,7 +9011,7 @@ Perl_sv_inc_nomg(pTHX_ SV *const sv)
     if (flags & SVp_NOK) {
        const NV was = SvNVX(sv);
        if (LIKELY(!Perl_isinfnan(was)) &&
-            NV_OVERFLOWS_INTEGERS_AT &&
+            NV_OVERFLOWS_INTEGERS_AT != 0.0 &&
            was >= NV_OVERFLOWS_INTEGERS_AT) {
            /* diag_listed_as: Lost precision when %s %f by 1 */
            Perl_ck_warner(aTHX_ packWARN(WARN_IMPRECISION),
@@ -9185,7 +9194,7 @@ Perl_sv_dec_nomg(pTHX_ SV *const sv)
        {
            const NV was = SvNVX(sv);
            if (LIKELY(!Perl_isinfnan(was)) &&
-                NV_OVERFLOWS_INTEGERS_AT &&
+                NV_OVERFLOWS_INTEGERS_AT != 0.0 &&
                was <= -NV_OVERFLOWS_INTEGERS_AT) {
                /* diag_listed_as: Lost precision when %s %f by 1 */
                Perl_ck_warner(aTHX_ packWARN(WARN_IMPRECISION),
@@ -11632,8 +11641,7 @@ S_format_hexfp(pTHX_ char * const buf, const STRLEN bufsize, const char c,
     /* In this case there is an implicit bit,
      * and therefore the exponent is shifted by one. */
     exponent--;
-#  else
-#    ifdef NV_X86_80_BIT
+#  elif defined(NV_X86_80_BIT)
     if (subnormal) {
         /* The subnormals of the x86-80 have a base exponent of -16382,
          * (while the physical exponent bits are zero) but the frexp()
@@ -11647,7 +11655,6 @@ S_format_hexfp(pTHX_ char * const buf, const STRLEN bufsize, const char c,
     } else {
         exponent -= 4;
     }
-#    endif
     /* TBD: other non-implicit-bit platforms than the x86-80. */
 #  endif
 #endif
@@ -11914,7 +11921,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
     bool has_utf8 = DO_UTF8(sv);    /* has the result utf8? */
     const bool pat_utf8 = has_utf8; /* the pattern is in utf8? */
     /* Times 4: a decimal digit takes more than 3 binary digits.
-     * NV_DIG: mantissa takes than many decimal digits.
+     * NV_DIG: mantissa takes that many decimal digits.
      * Plus 32: Playing safe. */
     char ebuf[IV_DIG * 4 + NV_DIG + 32];
     bool no_redundant_warning = FALSE; /* did we use any explicit format parameter index? */
@@ -12368,7 +12375,10 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
            if (args) {
                eptr = va_arg(*args, char*);
                if (eptr)
-                   elen = strlen(eptr);
+                    if (has_precis)
+                        elen = my_strnlen(eptr, precis);
+                    else
+                        elen = strlen(eptr);
                else {
                    eptr = (char *)nullstr;
                    elen = sizeof nullstr - 1;
@@ -13200,7 +13210,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                         ? my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, fv)
                         : my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, (double)fv));
 #else
-                elen = my_sprintf(PL_efloatbuf, ptr, fv);
+                elen = my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, fv);
 #endif
                 GCC_DIAG_RESTORE;
            }
@@ -14283,6 +14293,7 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
                else
                    LvTARG(dstr) = sv_dup_inc(LvTARG(dstr), param);
                if (isREGEXP(sstr)) goto duprex;
+               /* FALLTHROUGH */
            case SVt_PVGV:
                /* non-GP case already handled above */
                if(isGV_with_GP(sstr)) {
@@ -15326,7 +15337,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
 #ifdef USE_LOCALE_NUMERIC
     PL_numeric_standard        = proto_perl->Inumeric_standard;
-    PL_numeric_local   = proto_perl->Inumeric_local;
+    PL_numeric_underlying      = proto_perl->Inumeric_underlying;
 #endif /* !USE_LOCALE_NUMERIC */
 
     /* Did the locale setup indicate UTF-8? */
@@ -16908,6 +16919,7 @@ S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv,
        /* def-ness of rval pos() is independent of the def-ness of its arg */
        if ( !(obase->op_flags & OPf_MOD))
            break;
+        /* FALLTHROUGH */
 
     case OP_SCHOMP:
     case OP_CHOMP:
@@ -16983,6 +16995,9 @@ Perl_report_uninit(pTHX_ const SV *uninit_sv)
     if (PL_op) {
        desc = PL_op->op_type == OP_STRINGIFY && PL_op->op_folded
                ? "join or string"
+                : PL_op->op_type == OP_MULTICONCAT
+                    && (PL_op->op_private & OPpMULTICONCAT_FAKE)
+                ? "sprintf"
                : OP_DESC(PL_op);
        if (uninit_sv && PL_curpad) {
            varname = find_uninit_var(PL_op, uninit_sv, 0, &desc);
Unnamed repository; edit this file 'description' to name the repository.