This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
regen/unicode_constants.pl: Skip U+1E9E if not in Unicode version
[perl5.git] / dump.c
diff --git a/dump.c b/dump.c
index 926e5f8..7369a9a 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -477,9 +477,9 @@ Perl_sv_peek(pTHX_ SV *sv)
        }
     }
     else if (SvNOKp(sv)) {
-       STORE_NUMERIC_LOCAL_SET_STANDARD();
+       STORE_LC_NUMERIC_UNDERLYING_SET_STANDARD();
        Perl_sv_catpvf(aTHX_ t, "(%"NVgf")",SvNVX(sv));
-       RESTORE_NUMERIC_LOCAL();
+       RESTORE_LC_NUMERIC_UNDERLYING();
     }
     else if (SvIOKp(sv)) {
        if (SvIsUV(sv))
@@ -844,7 +844,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
         if (o->op_savefree) sv_catpvs(tmpsv, ",SAVEFREE");
         if (o->op_static)   sv_catpvs(tmpsv, ",STATIC");
         if (o->op_folded)   sv_catpvs(tmpsv, ",FOLDED");
-        if (o->op_lastsib)  sv_catpvs(tmpsv, ",LASTSIB");
+        if (o->op_moresib)  sv_catpvs(tmpsv, ",MORESIB");
         Perl_dump_indent(aTHX_ level, file, "FLAGS = (%s)\n",
                          SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");
     }
@@ -1106,7 +1106,7 @@ Perl_gv_dump(pTHX_ GV *gv)
         Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %s",
                      generic_pv_escape( tmp, name, len, SvUTF8(sv) ));
     }
-    PerlIO_putc(Perl_debug_log, '\n');
+    (void)PerlIO_putc(Perl_debug_log, '\n');
     Perl_dump_indent(aTHX_ 0, Perl_debug_log, "}\n");
 }
 
@@ -1116,7 +1116,7 @@ Perl_gv_dump(pTHX_ GV *gv)
  */
 
 static const struct { const char type; const char *name; } magic_names[] = {
-#include "mg_names.c"
+#include "mg_names.inc"
        /* this null string terminates the list */
        { 0,                         NULL },
 };
@@ -1227,7 +1227,7 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32
                 " ???? - " __FILE__
                 " does not know how to handle this MG_LEN"
                );
-            PerlIO_putc(file, '\n');
+            (void)PerlIO_putc(file, '\n');
         }
        if (mg->mg_type == PERL_MAGIC_utf8) {
            const STRLEN * const cache = (STRLEN *) mg->mg_ptr;
@@ -1270,7 +1270,7 @@ Perl_do_hv_dump(pTHX_ I32 level, PerlIO *file, const char *name, HV *sv)
                                    HvNAMELEN(sv), HvNAMEUTF8(sv)));
     }
     else
-       PerlIO_putc(file, '\n');
+        (void)PerlIO_putc(file, '\n');
 }
 
 void
@@ -1285,7 +1285,7 @@ Perl_do_gv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv)
                               generic_pv_escape( tmpsv, GvNAME(sv), GvNAMELEN(sv), GvNAMEUTF8(sv) ));
     }
     else
-       PerlIO_putc(file, '\n');
+        (void)PerlIO_putc(file, '\n');
 }
 
 void
@@ -1309,7 +1309,7 @@ Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv)
                               generic_pv_escape( tmp, GvNAME(sv), GvNAMELEN(sv), GvNAMEUTF8(sv)));
     }
     else
-       PerlIO_putc(file, '\n');
+        (void)PerlIO_putc(file, '\n');
 }
 
 const struct flag_to_name first_sv_flags_names[] = {
@@ -1415,7 +1415,6 @@ const struct flag_to_name regexp_core_intflags_names[] = {
     {PREGf_CUTGROUP_SEEN,   "CUTGROUP_SEEN,"},
     {PREGf_USE_RE_EVAL,     "USE_RE_EVAL,"},
     {PREGf_NOSCAN,          "NOSCAN,"},
-    {PREGf_CANY_SEEN,       "CANY_SEEN,"},
     {PREGf_GPOS_SEEN,       "GPOS_SEEN,"},
     {PREGf_GPOS_FLOAT,      "GPOS_FLOAT,"},
     {PREGf_ANCH_MBOL,       "ANCH_MBOL,"},
@@ -1555,29 +1554,20 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
         && type != SVt_REGEXP && !isGV_with_GP(sv) && !SvVALID(sv))
        || (type == SVt_IV && !SvROK(sv))) {
        if (SvIsUV(sv)
-#ifdef PERL_OLD_COPY_ON_WRITE
-                      || SvIsCOW(sv)
-#endif
                                     )
            Perl_dump_indent(aTHX_ level, file, "  UV = %"UVuf, (UV)SvUVX(sv));
        else
            Perl_dump_indent(aTHX_ level, file, "  IV = %"IVdf, (IV)SvIVX(sv));
-#ifdef PERL_OLD_COPY_ON_WRITE
-       if (SvIsCOW_shared_hash(sv))
-           PerlIO_printf(file, "  (HASH)");
-       else if (SvIsCOW_normal(sv))
-           PerlIO_printf(file, "  (COW from 0x%"UVxf")", (UV)SvUVX(sv));
-#endif
-       PerlIO_putc(file, '\n');
+       (void)PerlIO_putc(file, '\n');
     }
 
     if ((type >= SVt_PVNV && type != SVt_PVAV && type != SVt_PVHV
                && type != SVt_PVCV && type != SVt_PVFM  && type != SVt_REGEXP
                && type != SVt_PVIO && !isGV_with_GP(sv) && !SvVALID(sv))
               || type == SVt_NV) {
-       STORE_NUMERIC_LOCAL_SET_STANDARD();
+       STORE_LC_NUMERIC_UNDERLYING_SET_STANDARD();
        Perl_dump_indent(aTHX_ level, file, "  NV = %.*" NVgf "\n", NV_DIG, SvNVX(sv));
-       RESTORE_NUMERIC_LOCAL();
+       RESTORE_LC_NUMERIC_UNDERLYING();
     }
 
     if (SvROK(sv)) {
@@ -1630,7 +1620,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
            if (!re)
                Perl_dump_indent(aTHX_ level, file, "  LEN = %"IVdf"\n",
                                       (IV)SvLEN(sv));
-#ifdef PERL_NEW_COPY_ON_WRITE
+#ifdef PERL_COPY_ON_WRITE
            if (SvIsCOW(sv) && SvLEN(sv))
                Perl_dump_indent(aTHX_ level, file, "  COW_REFCNT = %d\n",
                                       CowREFCNT(sv));
@@ -1661,7 +1651,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
            Perl_dump_indent(aTHX_ level, file, "  ALLOC = 0x%"UVxf"\n", PTR2UV(AvALLOC(sv)));
        }
        else
-           PerlIO_putc(file, '\n');
+            (void)PerlIO_putc(file, '\n');
        Perl_dump_indent(aTHX_ level, file, "  FILL = %"IVdf"\n", (IV)AvFILLp(sv));
        Perl_dump_indent(aTHX_ level, file, "  MAX = %"IVdf"\n", (IV)AvMAX(sv));
        Perl_dump_indent(aTHX_ level, file, "  ARYLEN = 0x%"UVxf"\n",
@@ -1722,7 +1712,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
                        PerlIO_printf(file, ", ");
                }
             }
-           PerlIO_putc(file, ')');
+           (void)PerlIO_putc(file, ')');
            /* The "quality" of a hash is defined as the total number of
               comparisons needed to access every element once, relative
               to the expected number needed for a random hash.
@@ -1741,10 +1731,10 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
                pow2 = pow2 << 1;
            theoret = usedkeys;
            theoret += theoret * (theoret-1)/pow2;
-           PerlIO_putc(file, '\n');
+           (void)PerlIO_putc(file, '\n');
            Perl_dump_indent(aTHX_ level, file, "  hash quality = %.1"NVff"%%", theoret/sum*100);
        }
-       PerlIO_putc(file, '\n');
+       (void)PerlIO_putc(file, '\n');
        Perl_dump_indent(aTHX_ level, file, "  KEYS = %"IVdf"\n", (IV)usedkeys);
         {
             STRLEN count = 0;
@@ -1780,7 +1770,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
                 PerlIO_printf(file, " (LAST = 0x%"UVxf")", (UV)HvLASTRAND_get(sv));
             }
 #endif
-            PerlIO_putc(file, '\n');
+            (void)PerlIO_putc(file, '\n');
         }
        {
            MAGIC * const mg = mg_find(sv, PERL_MAGIC_symtab);
@@ -2318,7 +2308,7 @@ S_append_gv_name(pTHX_ GV *gv, SV *out)
     }
     sv = newSV(0);
     gv_fullname4(sv, gv, NULL, FALSE);
-    Perl_sv_catpvf(aTHX_ out, "%c%-p", '$', sv);
+    Perl_sv_catpvf(aTHX_ out, "$%"SVf, SVfARG(sv));
     SvREFCNT_dec_NN(sv);
 }
 
@@ -2525,8 +2515,8 @@ Perl_debop(pTHX_ const OP *o)
         break;
 
     case OP_MULTIDEREF:
-        PerlIO_printf(Perl_debug_log, "(%-p)",
-            multideref_stringify(o, deb_curcv(cxstack_ix)));
+        PerlIO_printf(Perl_debug_log, "(%"SVf")",
+            SVfARG(multideref_stringify(o, deb_curcv(cxstack_ix))));
         break;
 
     default:
@@ -2537,19 +2527,27 @@ Perl_debop(pTHX_ const OP *o)
 }
 
 STATIC CV*
-S_deb_curcv(pTHX_ const I32 ix)
+S_deb_curcv(pTHX_ I32 ix)
 {
-    const PERL_CONTEXT * const cx = &cxstack[ix];
-    if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT)
-        return cx->blk_sub.cv;
-    else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx))
-        return cx->blk_eval.cv;
-    else if (ix == 0 && PL_curstackinfo->si_type == PERLSI_MAIN)
-        return PL_main_cv;
-    else if (ix <= 0)
-        return NULL;
-    else
-        return deb_curcv(ix - 1);
+    PERL_SI *si = PL_curstackinfo;
+    for (; ix >=0; ix--) {
+        const PERL_CONTEXT * const cx = &(si->si_cxstack)[ix];
+
+        if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT)
+            return cx->blk_sub.cv;
+        else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx))
+            return cx->blk_eval.cv;
+        else if (ix == 0 && si->si_type == PERLSI_MAIN)
+            return PL_main_cv;
+        else if (ix == 0 && CxTYPE(cx) == CXt_NULL
+               && si->si_type == PERLSI_SORT)
+        {
+            /* fake sort sub; use CV of caller */
+            si = si->si_prev;
+            ix = si->si_cxix + 1;
+        }
+    }
+    return NULL;
 }
 
 void
@@ -2591,11 +2589,5 @@ Perl_debprofdump(pTHX)
 
 
 /*
- * Local variables:
- * c-indentation-style: bsd
- * c-basic-offset: 4
- * indent-tabs-mode: nil
- * End:
- *
  * ex: set ts=8 sts=4 sw=4 et:
  */