for (i = 0; i <= (I32) HvMAX(stash); i++) {
const HE *entry;
for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
- const GV * const gv = (const GV *)HeVAL(entry);
+ GV * gv = (GV *)HeVAL(entry);
+ if (SvROK(gv) && SvTYPE(SvRV(gv)) == SVt_PVCV)
+ /* unfake a fake GV */
+ (void)CvGV(SvRV(gv));
if (SvTYPE(gv) != SVt_PVGV || !GvGP(gv))
continue;
if (GvCVu(gv))
sv_catpv(tmpsv, &PL_op_private_labels[label]);
sv_catpv(tmpsv, "=");
}
- sv_catpv(tmpsv, &PL_op_private_labels[enum_label]);
+ if (enum_label == -1)
+ Perl_sv_catpvf(aTHX_ tmpsv, "0x%"UVxf, (UV)val);
+ else
+ sv_catpv(tmpsv, &PL_op_private_labels[enum_label]);
}
else {
const char* name;
SV *sv, *tmp = newSVpvs_flags("", SVs_TEMP);
-
- PERL_ARGS_ASSERT_GV_DUMP;
-
if (!gv) {
PerlIO_printf(Perl_debug_log, "{}\n");
return;
{RXf_PMf_EXTENDED, "PMf_EXTENDED,"},
{RXf_PMf_EXTENDED_MORE, "PMf_EXTENDED_MORE,"},
{RXf_PMf_KEEPCOPY, "PMf_KEEPCOPY,"},
+ {RXf_PMf_NOCAPTURE, "PMf_NOCAPURE,"},
{RXf_IS_ANCHORED, "IS_ANCHORED,"},
{RXf_NO_INPLACE_SUBST, "NO_INPLACE_SUBST,"},
{RXf_EVAL_SEEN, "EVAL_SEEN,"},
/* append to the out SV, the name of the lexical at offset off in the CV
* cv */
-void
+static void
S_append_padvar(pTHX_ PADOFFSET off, CV *cv, SV *out, int n,
bool paren, bool is_scalar)
{
if (namepad && (sv = padnamelist_fetch(namepad, off + i)))
{
STRLEN cur = SvCUR(out);
- Perl_sv_catpvf(aTHX_ out, "[%"PNf, PNfARG(sv));
+ Perl_sv_catpvf(aTHX_ out, "[%"UTF8f,
+ UTF8fARG(1, PadnameLEN(sv) - 1,
+ PadnamePV(sv) + 1));
if (is_scalar)
SvPVX(out)[cur] = '$';
}
}
-void
-S_print_gv_name(pTHX_ GV *gv, SV *out, char sigil)
+static void
+S_append_gv_name(pTHX_ GV *gv, SV *out)
{
SV *sv;
if (!gv) {
}
sv = newSV(0);
gv_fullname4(sv, gv, NULL, FALSE);
- Perl_sv_catpvf(aTHX_ out, "%c%-p", sigil, sv);
+ Perl_sv_catpvf(aTHX_ out, "%c%-p", '$', 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
/* return a temporary SV containing a stringified representation of
- * the op_aux field of a UNOP_AUX op, associated with CV cv
+ * the op_aux field of a MULTIDEREF op, associated with CV cv
*/
SV*
-Perl_unop_aux_stringify(pTHX_ const OP *o, CV *cv)
+Perl_multideref_stringify(pTHX_ const OP *o, CV *cv)
{
UNOP_AUX_item *items = cUNOP_AUXo->op_aux;
UV actions = items->uv;
bool last = 0;
bool is_hash = FALSE;
int derefs = 0;
- SV *out = sv_2mortal(newSVpv("",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_UNOP_AUX_STRINGIFY;
+ PERL_ARGS_ASSERT_MULTIDEREF_STRINGIFY;
while (!last) {
switch (actions & MDEREF_ACTION_MASK) {
case MDEREF_reload:
actions = (++items)->uv;
continue;
+ NOT_REACHED; /* NOTREACHED */
case MDEREF_HV_padhv_helem:
is_hash = TRUE;
+ /* FALLTHROUGH */
case MDEREF_AV_padav_aelem:
derefs = 1;
S_append_padvar(aTHX_ (++items)->pad_offset, cv, out, 1, 0, 1);
goto do_elem;
+ NOT_REACHED; /* NOTREACHED */
case MDEREF_HV_gvhv_helem:
is_hash = TRUE;
+ /* FALLTHROUGH */
case MDEREF_AV_gvav_aelem:
derefs = 1;
- sv = ITEM_SV(++items);
- S_print_gv_name(aTHX_ (GV*)sv, out, '$');
+ items++;
+ sv = ITEM_SV(items);
+ S_append_gv_name(aTHX_ (GV*)sv, out);
goto do_elem;
+ NOT_REACHED; /* NOTREACHED */
case MDEREF_HV_gvsv_vivify_rv2hv_helem:
is_hash = TRUE;
+ /* FALLTHROUGH */
case MDEREF_AV_gvsv_vivify_rv2av_aelem:
- sv = ITEM_SV(++items);
- S_print_gv_name(aTHX_ (GV*)sv, out, '$');
+ items++;
+ sv = ITEM_SV(items);
+ S_append_gv_name(aTHX_ (GV*)sv, out);
goto do_vivify_rv2xv_elem;
+ NOT_REACHED; /* NOTREACHED */
case MDEREF_HV_padsv_vivify_rv2hv_helem:
is_hash = TRUE;
+ /* FALLTHROUGH */
case MDEREF_AV_padsv_vivify_rv2av_aelem:
S_append_padvar(aTHX_ (++items)->pad_offset, cv, out, 1, 0, 1);
goto do_vivify_rv2xv_elem;
+ NOT_REACHED; /* NOTREACHED */
case MDEREF_HV_pop_rv2hv_helem:
case MDEREF_HV_vivify_rv2hv_helem:
is_hash = TRUE;
+ /* FALLTHROUGH */
do_vivify_rv2xv_elem:
case MDEREF_AV_pop_rv2av_aelem:
case MDEREF_AV_vivify_rv2av_aelem:
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);
S_append_padvar(aTHX_ (++items)->pad_offset, cv, out, 1, 0, 1);
break;
case MDEREF_INDEX_gvsv:
- sv = ITEM_SV(++items);
- S_print_gv_name(aTHX_ (GV*)sv, out, '$');
+ items++;
+ sv = ITEM_SV(items);
+ S_append_gv_name(aTHX_ (GV*)sv, out);
break;
}
sv_catpvn_nomg(out, (is_hash ? "}" : "]"), 1);
case OP_MULTIDEREF:
PerlIO_printf(Perl_debug_log, "(%-p)",
- unop_aux_stringify(o, deb_curcv(cxstack_ix)));
+ multideref_stringify(o, deb_curcv(cxstack_ix)));
break;
default:
}
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
https://perl5.git.perl.org / perl5.git / blobdiff