This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
silence some gcc -pendantic warnings
[perl5.git] / dump.c
diff --git a/dump.c b/dump.c
index 33bd527..d501cef 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 : "");
     }
@@ -1090,9 +1090,6 @@ Perl_gv_dump(pTHX_ GV *gv)
     const char* name;
     SV *sv, *tmp = newSVpvs_flags("", SVs_TEMP);
 
-
-    PERL_ARGS_ASSERT_GV_DUMP;
-
     if (!gv) {
        PerlIO_printf(Perl_debug_log, "{}\n");
        return;
@@ -1418,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,"},
@@ -1578,9 +1574,9 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
                && 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)) {
@@ -2321,12 +2317,13 @@ 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);
 }
 
 #ifdef USE_ITHREADS
-#  define ITEM_SV(item) *av_fetch(comppad, (item)->pad_offset, FALSE);
+#  define ITEM_SV(item) (comppad ? \
+    *av_fetch(comppad, (item)->pad_offset, FALSE) : NULL);
 #else
 #  define ITEM_SV(item) UNOP_AUX_item_sv(item)
 #endif
@@ -2347,8 +2344,14 @@ Perl_multideref_stringify(pTHX_ const OP *o, CV *cv)
     int derefs = 0;
     SV *out = newSVpvn_flags("",0,SVs_TEMP);
 #ifdef USE_ITHREADS
-    PADLIST * const padlist = CvPADLIST(cv);
-    PAD *comppad = PadlistARRAY(padlist)[1];
+    PAD *comppad;
+
+    if (cv) {
+        PADLIST *padlist = CvPADLIST(cv);
+        comppad = PadlistARRAY(padlist)[1];
+    }
+    else
+        comppad = NULL;
 #endif
 
     PERL_ARGS_ASSERT_MULTIDEREF_STRINGIFY;
@@ -2375,7 +2378,8 @@ Perl_multideref_stringify(pTHX_ const OP *o, CV *cv)
             /* FALLTHROUGH */
         case MDEREF_AV_gvav_aelem:
             derefs = 1;
-            sv = ITEM_SV(++items);
+            items++;
+            sv = ITEM_SV(items);
             S_append_gv_name(aTHX_ (GV*)sv, out);
             goto do_elem;
             NOT_REACHED; /* NOTREACHED */
@@ -2384,7 +2388,8 @@ Perl_multideref_stringify(pTHX_ const OP *o, CV *cv)
             is_hash = TRUE;
             /* FALLTHROUGH */
         case MDEREF_AV_gvsv_vivify_rv2av_aelem:
-            sv = ITEM_SV(++items);
+            items++;
+            sv = ITEM_SV(items);
             S_append_gv_name(aTHX_ (GV*)sv, out);
             goto do_vivify_rv2xv_elem;
             NOT_REACHED; /* NOTREACHED */
@@ -2417,15 +2422,20 @@ Perl_multideref_stringify(pTHX_ const OP *o, CV *cv)
             switch (actions & MDEREF_INDEX_MASK) {
             case MDEREF_INDEX_const:
                 if (is_hash) {
-                    STRLEN cur;
-                    char *s;
-                    sv = ITEM_SV(++items);
-                    s = SvPV(sv, cur);
-                    pv_pretty(out, s, cur, 30,
-                                NULL, NULL,
-                                (PERL_PV_PRETTY_NOCLEAR
-                                |PERL_PV_PRETTY_QUOTE
-                                |PERL_PV_PRETTY_ELLIPSES));
+                    items++;
+                    sv = ITEM_SV(items);
+                    if (!sv)
+                        sv_catpvs_nomg(out, "???");
+                    else {
+                        STRLEN cur;
+                        char *s;
+                        s = SvPV(sv, cur);
+                        pv_pretty(out, s, cur, 30,
+                                    NULL, NULL,
+                                    (PERL_PV_PRETTY_NOCLEAR
+                                    |PERL_PV_PRETTY_QUOTE
+                                    |PERL_PV_PRETTY_ELLIPSES));
+                    }
                 }
                 else
                     Perl_sv_catpvf(aTHX_ out, "%"IVdf, (++items)->iv);
@@ -2434,7 +2444,8 @@ Perl_multideref_stringify(pTHX_ const OP *o, CV *cv)
                 S_append_padvar(aTHX_ (++items)->pad_offset, cv, out, 1, 0, 1);
                 break;
             case MDEREF_INDEX_gvsv:
-                sv = ITEM_SV(++items);
+                items++;
+                sv = ITEM_SV(items);
                 S_append_gv_name(aTHX_ (GV*)sv, out);
                 break;
             }
@@ -2513,8 +2524,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:
@@ -2525,19 +2536,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
@@ -2579,11 +2598,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:
  */