diff options
| -rw-r--r-- | cop.h | 2 | ||||
| -rw-r--r-- | doio.c | 3 | ||||
| -rw-r--r-- | op.c | 10 | ||||
| -rw-r--r-- | pad.c | 12 | ||||
| -rw-r--r-- | perl.c | 4 | ||||
| -rw-r--r-- | pod/perldiag.pod | 42 | ||||
| -rw-r--r-- | pp.c | 2 | ||||
| -rw-r--r-- | pp_ctl.c | 7 | ||||
| -rw-r--r-- | pp_hot.c | 9 | ||||
| -rw-r--r-- | pp_pack.c | 11 | ||||
| -rw-r--r-- | pp_sys.c | 2 | ||||
| -rw-r--r-- | regcomp.c | 13 | ||||
| -rw-r--r-- | regexec.c | 3 | ||||
| -rw-r--r-- | scope.c | 4 | ||||
| -rw-r--r-- | sv.c | 9 | ||||
| -rw-r--r-- | toke.c | 17 | ||||
| -rw-r--r-- | utf8.c | 22 | ||||
| -rw-r--r-- | util.c | 39 |
18 files changed, 131 insertions, 80 deletions
@@ -138,7 +138,7 @@ typedef struct jmpenv JMPENV; PerlProc_longjmp(PL_top_env->je_buf, (v)); \ if ((v) == 2) \ PerlProc_exit(STATUS_EXIT); \ - PerlIO_printf(PerlIO_stderr(), "panic: top_env\n"); \ + PerlIO_printf(PerlIO_stderr(), "panic: top_env, v=%d\n", (int)v); \ PerlProc_exit(1); \ } STMT_END @@ -149,7 +149,8 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw, int ismodifying; if (num_svs != 0) { - Perl_croak(aTHX_ "panic: sysopen with multiple args"); + Perl_croak(aTHX_ "panic: sysopen with multiple args, num_svs=%ld", + (long) num_svs); } /* It's not always @@ -837,7 +837,8 @@ Perl_op_contextualize(pTHX_ OP *o, I32 context) case G_ARRAY: return list(o); case G_VOID: return scalarvoid(o); default: - Perl_croak(aTHX_ "panic: op_contextualize bad context"); + Perl_croak(aTHX_ "panic: op_contextualize bad context %ld", + (long) context); return o; } } @@ -8149,7 +8150,7 @@ Perl_ck_grep(pTHX_ OP *o) return o; kid = cLISTOPo->op_first->op_sibling; if (kid->op_type != OP_NULL) - Perl_croak(aTHX_ "panic: ck_grep"); + Perl_croak(aTHX_ "panic: ck_grep, type=%u", (unsigned) kid->op_type); kid = kUNOP->op_first; if (!gwop) @@ -8857,7 +8858,7 @@ Perl_ck_split(pTHX_ OP *o) kid = cLISTOPo->op_first; if (kid->op_type != OP_NULL) - Perl_croak(aTHX_ "panic: ck_split"); + Perl_croak(aTHX_ "panic: ck_split, type=%u", (unsigned) kid->op_type); kid = kid->op_sibling; op_free(cLISTOPo->op_first); if (kid) @@ -9081,7 +9082,8 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv) const char *e = NULL; PERL_ARGS_ASSERT_CK_ENTERSUB_ARGS_PROTO; if (SvTYPE(protosv) == SVt_PVCV ? !SvPOK(protosv) : !SvOK(protosv)) - Perl_croak(aTHX_ "panic: ck_entersub_args_proto CV with no proto"); + Perl_croak(aTHX_ "panic: ck_entersub_args_proto CV with no proto," + "flags=%lx", (unsigned long) SvFLAGS(protosv)); if (SvTYPE(protosv) == SVt_PVCV) proto = CvPROTO(protosv), proto_len = CvPROTOLEN(protosv); else proto = SvPV(protosv, proto_len); @@ -669,7 +669,8 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype) ASSERT_CURPAD_ACTIVE("pad_alloc"); if (AvARRAY(PL_comppad) != PL_curpad) - Perl_croak(aTHX_ "panic: pad_alloc"); + Perl_croak(aTHX_ "panic: pad_alloc, %p!=%p", + AvARRAY(PL_comppad), PL_curpad); if (PL_pad_reset_pending) pad_reset(); if (tmptype & SVs_PADMY) { @@ -1513,7 +1514,8 @@ Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust) if (!PL_curpad) return; if (AvARRAY(PL_comppad) != PL_curpad) - Perl_croak(aTHX_ "panic: pad_swipe curpad"); + Perl_croak(aTHX_ "panic: pad_swipe curpad, %p!=%p", + AvARRAY(PL_comppad), PL_curpad); if (!po) Perl_croak(aTHX_ "panic: pad_swipe po"); @@ -1559,7 +1561,8 @@ S_pad_reset(pTHX) dVAR; #ifdef USE_BROKEN_PAD_RESET if (AvARRAY(PL_comppad) != PL_curpad) - Perl_croak(aTHX_ "panic: pad_reset curpad"); + Perl_croak(aTHX_ "panic: pad_reset curpad, %p!=%p", + AvARRAY(PL_comppad), PL_curpad); DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf"[0x%"UVxf"] reset: padix %ld -> %ld", @@ -1712,7 +1715,8 @@ Perl_pad_free(pTHX_ PADOFFSET po) if (!PL_curpad) return; if (AvARRAY(PL_comppad) != PL_curpad) - Perl_croak(aTHX_ "panic: pad_free curpad"); + Perl_croak(aTHX_ "panic: pad_free curpad, %p!=%p", + AvARRAY(PL_comppad), PL_curpad); if (!po) Perl_croak(aTHX_ "panic: pad_free po"); @@ -2330,7 +2330,7 @@ perl_run(pTHXx) POPSTACK_TO(PL_mainstack); goto redo_body; } - PerlIO_printf(Perl_error_log, "panic: restartop\n"); + PerlIO_printf(Perl_error_log, "panic: restartop in perl_run\n"); FREETMPS; ret = 1; break; @@ -4820,7 +4820,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList) CopLINE_set(PL_curcop, oldline); JMPENV_JUMP(3); } - PerlIO_printf(Perl_error_log, "panic: restartop\n"); + PerlIO_printf(Perl_error_log, "panic: restartop in call_list\n"); FREETMPS; break; } diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 544a9ed6b4..9263de2989 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -3517,15 +3517,15 @@ an ACL related-function, but that function is not available on this platform. Earlier checks mean that it should not be possible to enter this branch on this platform. -=item panic: ck_grep +=item panic: ck_grep, type=%u (P) Failed an internal consistency check trying to compile a grep. -=item panic: ck_split +=item panic: ck_split, type=%u (P) Failed an internal consistency check trying to compile a split. -=item panic: corrupt saved stack index +=item panic: corrupt saved stack index %ld (P) The savestack was requested to restore more localized values than there are in the savestack. @@ -3559,7 +3559,7 @@ failure was caught. (P) The library function frexp() failed, making printf("%f") impossible. -=item panic: goto +=item panic: goto, type=%u, ix=%ld (P) We popped the context stack to a context with the specified label, and then discovered it wasn't a context we know how to do a goto in. @@ -3571,11 +3571,11 @@ repeatedly, but each time something re-created entries in the glob. Most likely the glob contains an object with a reference back to the glob and a destructor that adds a new object to the glob. -=item panic: INTERPCASEMOD +=item panic: INTERPCASEMOD, %s (P) The lexer got into a bad state at a case modifier. -=item panic: INTERPCONCAT +=item panic: INTERPCONCAT, %s (P) The lexer got into a bad state parsing a string with brackets. @@ -3583,7 +3583,7 @@ the glob and a destructor that adds a new object to the glob. (F) forked child returned an incomprehensible message about its errno. -=item panic: last +=item panic: last, type=%u (P) We popped the context stack to a block context, and then discovered it wasn't a block context. @@ -3593,7 +3593,7 @@ it wasn't a block context. (P) A writable lexical variable became read-only somehow within the scope. -=item panic: leave_scope inconsistency +=item panic: leave_scope inconsistency %u (P) The savestack probably got out of sync. At least, there was an invalid enum on the top of it. @@ -3603,7 +3603,7 @@ invalid enum on the top of it. (P) Failed an internal consistency check while trying to reset all weak references to an object. -=item panic: malloc +=item panic: malloc, %s (P) Something requested a negative number of bytes of malloc. @@ -3611,12 +3611,12 @@ references to an object. (P) Something tried to allocate more memory than possible. -=item panic: pad_alloc +=item panic: pad_alloc, %p!=%p (P) The compiler got confused about which scratch pad it was allocating and freeing temporaries and lexicals from. -=item panic: pad_free curpad +=item panic: pad_free curpad, %p!=%p (P) The compiler got confused about which scratch pad it was allocating and freeing temporaries and lexicals from. @@ -3625,7 +3625,7 @@ and freeing temporaries and lexicals from. (P) An invalid scratch pad offset was detected internally. -=item panic: pad_reset curpad +=item panic: pad_reset curpad, %p!=%p (P) The compiler got confused about which scratch pad it was allocating and freeing temporaries and lexicals from. @@ -3634,7 +3634,7 @@ and freeing temporaries and lexicals from. (P) An invalid scratch pad offset was detected internally. -=item panic: pad_swipe curpad +=item panic: pad_swipe curpad, %p!=%p (P) The compiler got confused about which scratch pad it was allocating and freeing temporaries and lexicals from. @@ -3643,7 +3643,7 @@ and freeing temporaries and lexicals from. (P) An invalid scratch pad offset was detected internally. -=item panic: pp_iter +=item panic: pp_iter, type=%u (P) The foreach iterator got called in a non-loop context frame. @@ -3652,11 +3652,11 @@ and freeing temporaries and lexicals from. (P) The internal pp_match() routine was called with invalid operational data. -=item panic: pp_split +=item panic: pp_split, pm=%p, s=%p (P) Something terrible went wrong in setting up for the split. -=item panic: realloc +=item panic: realloc, %s (P) Something requested a negative number of bytes of realloc. @@ -3665,17 +3665,17 @@ data. (P) The internal sv_replace() function was handed a new SV with a reference count other than 1. -=item panic: restartop +=item panic: restartop in %s (P) Some internal routine requested a goto (or something like it), and didn't supply the destination. -=item panic: return +=item panic: return, type=%u (P) We popped the context stack to a subroutine or eval context, and then discovered it wasn't a subroutine or eval context. -=item panic: scan_num +=item panic: scan_num, %s (P) scan_num() got called on something that wasn't a number. @@ -3684,7 +3684,7 @@ then discovered it wasn't a subroutine or eval context. (P) The sv_chop() routine was passed a position that is not within the scalar's string buffer. -=item panic: sv_insert +=item panic: sv_insert, midend=%p, bigend=%p (P) The sv_insert() routine was told to remove more string than there was string. @@ -3714,7 +3714,7 @@ to even) byte length. (P) Something tried to call utf16_to_utf8_reversed with an odd (as opposed to even) byte length. -=item panic: yylex +=item panic: yylex, %s (P) The lexer got into a bad state while processing a case modifier. @@ -5225,7 +5225,7 @@ PP(pp_split) pm = (PMOP*)POPs; #endif if (!pm || !s) - DIE(aTHX_ "panic: pp_split"); + DIE(aTHX_ "panic: pp_split, pm=%p, s=%p", pm, s); rx = PM_GETRE(pm); TAINT_IF(get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET && @@ -2487,7 +2487,7 @@ PP(pp_return) retop = cx->blk_sub.retop; break; default: - DIE(aTHX_ "panic: return"); + DIE(aTHX_ "panic: return, type=%u", (unsigned) CxTYPE(cx)); } TAINT_NOT; @@ -2634,7 +2634,7 @@ PP(pp_last) nextop = cx->blk_sub.retop; break; default: - DIE(aTHX_ "panic: last"); + DIE(aTHX_ "panic: last, type=%u", (unsigned) CxTYPE(cx)); } TAINT_NOT; @@ -3058,7 +3058,8 @@ PP(pp_goto) DIE(aTHX_ "Can't \"goto\" out of a pseudo block"); default: if (ix) - DIE(aTHX_ "panic: goto"); + DIE(aTHX_ "panic: goto, type=%u, ix=%ld", + CxTYPE(cx), (long) ix); gotoprobe = PL_main_root; break; } @@ -1390,7 +1390,10 @@ PP(pp_match) s = RX_OFFS(rx)[i].start + truebase; if (RX_OFFS(rx)[i].end < 0 || RX_OFFS(rx)[i].start < 0 || len < 0 || len > strend - s) - DIE(aTHX_ "panic: pp_match start/end pointers"); + DIE(aTHX_ "panic: pp_match start/end pointers, i=%ld, " + "start=%ld, end=%ld, s=%p, strend=%p, len=%"UVuf, + (long) i, (long) RX_OFFS(rx)[i].start, + (long)RX_OFFS(rx)[i].end, s, strend, (UV) len); sv_setpvn(*SP, s, len); if (DO_UTF8(TARG) && is_utf8_string((U8*)s, len)) SvUTF8_on(*SP); @@ -1841,7 +1844,7 @@ PP(pp_iter) EXTEND(SP, 1); cx = &cxstack[cxstack_ix]; if (!CxTYPE_is_LOOP(cx)) - DIE(aTHX_ "panic: pp_iter"); + DIE(aTHX_ "panic: pp_iter, type=%u", CxTYPE(cx)); itersvp = CxITERVAR(cx); if (CxTYPE(cx) == CXt_LOOP_LAZYSV) { @@ -2119,7 +2122,7 @@ PP(pp_subst) force_it: if (!pm || !s) - DIE(aTHX_ "panic: pp_subst"); + DIE(aTHX_ "panic: pp_subst, pm=%p, s=%p", pm, s); strend = s + len; slen = RX_MATCH_UTF8(rx) ? utf8_length((U8*)s, (U8*)strend) : len; @@ -2455,7 +2455,8 @@ marked_upgrade(pTHX_ SV *sv, tempsym_t *sym_ptr) { if (m != marks + sym_ptr->level+1) { Safefree(marks); Safefree(to_start); - Perl_croak(aTHX_ "panic: marks beyond string end"); + Perl_croak(aTHX_ "panic: marks beyond string end, m=%p, marks=%p, " + "level=%d", m, marks, sym_ptr->level); } for (group=sym_ptr; group; group = group->previous) group->strbeg = marks[group->level] - to_start; @@ -2789,7 +2790,9 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) GROWING(0, cat, start, cur, len); if (!uni_to_bytes(aTHX_ &aptr, end, cur, fromlen, datumtype | TYPE_IS_PACK)) - Perl_croak(aTHX_ "panic: predicted utf8 length not available"); + Perl_croak(aTHX_ "panic: predicted utf8 length not available, " + "for '%c', aptr=%p end=%p cur=%p, fromlen=%"UVuf, + (int)datumtype, aptr, end, cur, (UV)fromlen); cur += fromlen; len -= fromlen; } else if (utf8) { @@ -3584,7 +3587,9 @@ extern const double _double_constants[]; 'u' | TYPE_IS_PACK)) { *cur = '\0'; SvCUR_set(cat, cur - start); - Perl_croak(aTHX_ "panic: string is shorter than advertised"); + Perl_croak(aTHX_ "panic: string is shorter than advertised, " + "aptr=%p, aend=%p, buffer=%p, todo=%ld", + aptr, aend, buffer, (long) todo); } end = doencodes(hunk, buffer, todo); } else { @@ -4198,7 +4198,7 @@ PP(pp_system) PerlLIO_close(pp[0]); if (n) { /* Error */ if (n != sizeof(int)) - DIE(aTHX_ "panic: kid popen errno read"); + DIE(aTHX_ "panic: kid popen errno read, n=%u", n); errno = errkid; /* Propagate errno from kid */ STATUS_NATIVE_CHILD_SET(-1); } @@ -5778,7 +5778,8 @@ S_reg_scan_name(pTHX_ RExC_state_t *pRExC_state, U32 flags) return sv_dat; } else { - Perl_croak(aTHX_ "panic: bad flag in reg_scan_name"); + Perl_croak(aTHX_ "panic: bad flag %lx in reg_scan_name", + (unsigned long) flags); } /* NOT REACHED */ } @@ -6093,7 +6094,9 @@ Perl__append_range_to_invlist(pTHX_ SV* const invlist, const UV start, const UV if (array[final_element] > start || ELEMENT_RANGE_MATCHES_INVLIST(final_element)) { - Perl_croak(aTHX_ "panic: attempting to append to an inversion list, but wasn't at the end of the list"); + Perl_croak(aTHX_ "panic: attempting to append to an inversion list, but wasn't at the end of the list, final=%"UVuf", start=%"UVuf", match=%c", + array[final_element], start, + ELEMENT_RANGE_MATCHES_INVLIST(final_element) ? 't' : 'f'); } /* Here, it is a legal append. If the new range begins with the first @@ -11354,7 +11357,8 @@ S_reg_node(pTHX_ RExC_state_t *pRExC_state, U8 op) return(ret); } if (RExC_emit >= RExC_emit_bound) - Perl_croak(aTHX_ "panic: reg_node overrun trying to emit %d", op); + Perl_croak(aTHX_ "panic: reg_node overrun trying to emit %d, %p>=%p", + op, RExC_emit, RExC_emit_bound); NODE_ALIGN_FILL(ret); ptr = ret; @@ -11409,7 +11413,8 @@ S_reganode(pTHX_ RExC_state_t *pRExC_state, U8 op, U32 arg) return(ret); } if (RExC_emit >= RExC_emit_bound) - Perl_croak(aTHX_ "panic: reg_node overrun trying to emit %d", op); + Perl_croak(aTHX_ "panic: reg_node overrun trying to emit %d, %p>=%p", + op, RExC_emit, RExC_emit_bound); NODE_ALIGN_FILL(ret); ptr = ret; @@ -353,7 +353,8 @@ S_regcppush(pTHX_ I32 parenfloor) GET_RE_DEBUG_FLAGS_DECL; if (paren_elems_to_push < 0) - Perl_croak(aTHX_ "panic: paren_elems_to_push < 0"); + Perl_croak(aTHX_ "panic: paren_elems_to_push, %i < 0", + paren_elems_to_push); if ((elems_shifted >> SAVE_TIGHT_SHIFT) != total_elems) Perl_croak(aTHX_ "panic: paren_elems_to_push offset %"UVuf @@ -714,7 +714,7 @@ Perl_leave_scope(pTHX_ I32 base) bool was = PL_tainted; if (base < -1) - Perl_croak(aTHX_ "panic: corrupt saved stack index"); + Perl_croak(aTHX_ "panic: corrupt saved stack index %ld", (long) base); DEBUG_l(Perl_deb(aTHX_ "savestack: releasing items %ld -> %ld\n", (long)PL_savestack_ix, (long)base)); while (PL_savestack_ix > base) { @@ -1160,7 +1160,7 @@ Perl_leave_scope(pTHX_ I32 base) parser_free((yy_parser *) ptr); break; default: - Perl_croak(aTHX_ "panic: leave_scope inconsistency"); + Perl_croak(aTHX_ "panic: leave_scope inconsistency %u", type); } } @@ -4478,7 +4478,8 @@ Perl_sv_setpvn(pTHX_ register SV *const sv, register const char *const ptr, regi /* len is STRLEN which is unsigned, need to copy to signed */ const IV iv = len; if (iv < 0) - Perl_croak(aTHX_ "panic: sv_setpvn called with negative strlen"); + Perl_croak(aTHX_ "panic: sv_setpvn called with negative strlen %" + IVdf, iv); } SvUPGRADE(sv, SVt_PV); @@ -5793,7 +5794,8 @@ Perl_sv_insert_flags(pTHX_ SV *const bigstr, const STRLEN offset, const STRLEN l bigend = big + SvCUR(bigstr); if (midend > bigend) - Perl_croak(aTHX_ "panic: sv_insert"); + Perl_croak(aTHX_ "panic: sv_insert, midend=%p, bigend=%p", + midend, bigend); if (mid - big > bigend - midend) { /* faster to shorten from end */ if (littlelen) { @@ -7076,7 +7078,8 @@ Perl_sv_pos_b2u(pTHX_ register SV *const sv, I32 *const offsetp) s = (const U8*)SvPV_const(sv, blen); if (blen < byte) - Perl_croak(aTHX_ "panic: sv_pos_b2u: bad byte offset"); + Perl_croak(aTHX_ "panic: sv_pos_b2u: bad byte offset, blen=%"UVuf + ", byte=%"UVuf, (UV)blen, (UV)byte); send = s + byte; @@ -3509,7 +3509,8 @@ S_scan_const(pTHX_ char *start) *d = '\0'; SvCUR_set(sv, d - SvPVX_const(sv)); if (SvCUR(sv) >= SvLEN(sv)) - Perl_croak(aTHX_ "panic: constant overflowed allocated space"); + Perl_croak(aTHX_ "panic: constant overflowed allocated space, %"UVuf + " >= %"UVuf, (UV)SvCUR(sv), (UV)SvLEN(sv)); SvPOK_on(sv); if (PL_encoding && !has_utf8) { @@ -4476,7 +4477,9 @@ Perl_yylex(pTHX) case LEX_INTERPCASEMOD: #ifdef DEBUGGING if (PL_bufptr != PL_bufend && *PL_bufptr != '\\') - Perl_croak(aTHX_ "panic: INTERPCASEMOD"); + Perl_croak(aTHX_ + "panic: INTERPCASEMOD bufptr=%p, bufend=%p, *bufptr=%u", + PL_bufptr, PL_bufend, *PL_bufptr); #endif /* handle \E or end of string */ if (PL_bufptr == PL_bufend || PL_bufptr[1] == 'E') { @@ -4562,7 +4565,7 @@ Perl_yylex(pTHX) else if (*s == 'Q') NEXTVAL_NEXTTOKE.ival = OP_QUOTEMETA; else - Perl_croak(aTHX_ "panic: yylex"); + Perl_croak(aTHX_ "panic: yylex, *s=%u", *s); if (PL_madskills) { SV* const tmpsv = newSVpvs("\\ "); /* replace the space with the character we want to escape @@ -4669,7 +4672,8 @@ Perl_yylex(pTHX) case LEX_INTERPCONCAT: #ifdef DEBUGGING if (PL_lex_brackets) - Perl_croak(aTHX_ "panic: INTERPCONCAT"); + Perl_croak(aTHX_ "panic: INTERPCONCAT, lex_brackets=%ld", + (long) PL_lex_brackets); #endif if (PL_bufptr == PL_bufend) return REPORT(sublex_done()); @@ -5156,7 +5160,8 @@ Perl_yylex(pTHX) if (d < PL_bufend) d++; else if (d > PL_bufend) /* Found by Ilya: feed random input to Perl. */ - Perl_croak(aTHX_ "panic: input overflow"); + Perl_croak(aTHX_ "panic: input overflow, %p > %p", + d, PL_bufend); #ifdef PERL_MAD if (PL_madskills) PL_thiswhite = newSVpvn(s, d - s); @@ -10180,7 +10185,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) switch (*s) { default: - Perl_croak(aTHX_ "panic: scan_num"); + Perl_croak(aTHX_ "panic: scan_num, *s=%d", *s); /* if it starts with a 0, it could be an octal number, a decimal in 0.13 disguise, or a hexadecimal number, or a binary number. */ @@ -2775,7 +2775,9 @@ Perl_swash_fetch(pTHX_ SV *swash, const U8 *ptr, bool do_utf8) if (!svp || !(tmps = (U8*)SvPV(*svp, slen)) || (slen << 3) < needents) - Perl_croak(aTHX_ "panic: swash_fetch got improper swatch"); + Perl_croak(aTHX_ "panic: swash_fetch got improper swatch, " + "svp=%p, tmps=%p, slen=%"UVuf", needents=%"UVuf, + svp, tmps, (UV)slen, (UV)needents); } PL_last_swash_hv = hv; @@ -2820,7 +2822,8 @@ Perl_swash_fetch(pTHX_ SV *swash, const U8 *ptr, bool do_utf8) off <<= 2; return (tmps[off] << 24) + (tmps[off+1] << 16) + (tmps[off+2] << 8) + tmps[off + 3] ; } - Perl_croak(aTHX_ "panic: swash_fetch got swatch of unexpected bit width"); + Perl_croak(aTHX_ "panic: swash_fetch got swatch of unexpected bit width, " + "slen=%"UVuf", needents=%"UVuf, (UV)slen, (UV)needents); NORETURN_FUNCTION_END; } @@ -3153,7 +3156,8 @@ S_swatch_get(pTHX_ SV* swash, UV start, UV span) otherbitssvp = hv_fetchs(otherhv, "BITS", FALSE); otherbits = (STRLEN)SvUV(*otherbitssvp); if (bits < otherbits) - Perl_croak(aTHX_ "panic: swatch_get found swatch size mismatch"); + Perl_croak(aTHX_ "panic: swatch_get found swatch size mismatch, " + "bits=%"UVuf", otherbits=%"UVuf, (UV)bits, (UV)otherbits); /* The "other" swatch must be destroyed after. */ other = swatch_get(*othersvp, start, span); @@ -3165,7 +3169,9 @@ S_swatch_get(pTHX_ SV* swash, UV start, UV span) s = (U8*)SvPV(swatch, slen); if (bits == 1 && otherbits == 1) { if (slen != olen) - Perl_croak(aTHX_ "panic: swatch_get found swatch length mismatch"); + Perl_croak(aTHX_ "panic: swatch_get found swatch length " + "mismatch, slen=%"UVuf", olen=%"UVuf, + (UV)slen, (UV)olen); switch (opc) { case '+': @@ -3330,7 +3336,9 @@ Perl__swash_inversion_hash(pTHX_ SV* const swash) while ((sv_to = hv_iternextsv(specials_hv, &char_from, &from_len))) { SV** listp; if (! SvPOK(sv_to)) { - Perl_croak(aTHX_ "panic: value returned from hv_iternextsv() unexpectedly is not a string"); + Perl_croak(aTHX_ "panic: value returned from hv_iternextsv() " + "unexpectedly is not a string, flags=%lu", + (unsigned long)SvFLAGS(sv_to)); } /*DEBUG_U(PerlIO_printf(Perl_debug_log, "Found mapping from %"UVXf", First char of to is %"UVXf"\n", utf8_to_uvchr((U8*) char_from, 0), utf8_to_uvchr((U8*) SvPVX(sv_to), 0)));*/ @@ -3638,7 +3646,9 @@ Perl__swash_to_invlist(pTHX_ SV* const swash) otherbits = (STRLEN)SvUV(*otherbitssvp); if (bits != otherbits || bits != 1) { - Perl_croak(aTHX_ "panic: _swash_to_invlist only operates on boolean properties"); + Perl_croak(aTHX_ "panic: _swash_to_invlist only operates on boolean " + "properties, bits=%"UVuf", otherbits=%"UVuf, + (UV)bits, (UV)otherbits); } /* The "other" swatch must be destroyed after. */ @@ -95,7 +95,7 @@ Perl_safesysmalloc(MEM_SIZE size) #endif #ifdef DEBUGGING if ((SSize_t)size < 0) - Perl_croak_nocontext("panic: malloc"); + Perl_croak_nocontext("panic: malloc, size=%"UVuf, (UV) size); #endif ptr = (Malloc_t)PerlMem_malloc(size?size:1); /* malloc(0) is NASTY on our system */ PERL_ALLOC_CHECK(ptr); @@ -172,7 +172,8 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size) = (struct perl_memory_debug_header *)where; if (header->interpreter != aTHX) { - Perl_croak_nocontext("panic: realloc from wrong pool"); + Perl_croak_nocontext("panic: realloc from wrong pool, %p!=%p", + header->interpreter, aTHX); } assert(header->next->prev == header); assert(header->prev->next == header); @@ -188,7 +189,7 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size) #endif #ifdef DEBUGGING if ((SSize_t)size < 0) - Perl_croak_nocontext("panic: realloc"); + Perl_croak_nocontext("panic: realloc, size=%"UVuf, (UV)size); #endif ptr = (Malloc_t)PerlMem_realloc(where,size); PERL_ALLOC_CHECK(ptr); @@ -258,14 +259,19 @@ Perl_safesysfree(Malloc_t where) = (struct perl_memory_debug_header *)where; if (header->interpreter != aTHX) { - Perl_croak_nocontext("panic: free from wrong pool"); + Perl_croak_nocontext("panic: free from wrong pool, %p!=%p", + header->interpreter, aTHX); } if (!header->prev) { Perl_croak_nocontext("panic: duplicate free"); } - if (!(header->next) || header->next->prev != header - || header->prev->next != header) { - Perl_croak_nocontext("panic: bad free"); + if (!(header->next)) + Perl_croak_nocontext("panic: bad free, header->next==NULL"); + if (header->next->prev != header || header->prev->next != header) { + Perl_croak_nocontext("panic: bad free, ->next->prev=%p, " + "header=%p, ->prev->next=%p", + header->next->prev, header, + header->prev->next); } /* Unlink us from the chain. */ header->next->prev = header->prev; @@ -317,7 +323,8 @@ Perl_safesyscalloc(MEM_SIZE count, MEM_SIZE size) #endif /* HAS_64K_LIMIT */ #ifdef DEBUGGING if ((SSize_t)size < 0 || (SSize_t)count < 0) - Perl_croak_nocontext("panic: calloc"); + Perl_croak_nocontext("panic: calloc, size=%"UVuf", count=%"UVuf, + (UV)size, (UV)count); #endif #ifdef PERL_TRACK_MEMPOOL /* Have to use malloc() because we've added some space for our tracking @@ -2735,7 +2742,7 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args) int pid2, status; PerlLIO_close(p[This]); if (n != sizeof(int)) - Perl_croak(aTHX_ "panic: kid popen errno read"); + Perl_croak(aTHX_ "panic: kid popen errno read, n=%u", n); do { pid2 = wait4pid(pid, &status, 0); } while (pid2 == -1 && errno == EINTR); @@ -2894,7 +2901,7 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode) int pid2, status; PerlLIO_close(p[This]); if (n != sizeof(int)) - Perl_croak(aTHX_ "panic: kid popen errno read"); + Perl_croak(aTHX_ "panic: kid popen errno read, n=%u", n); do { pid2 = wait4pid(pid, &status, 0); } while (pid2 == -1 && errno == EINTR); @@ -3705,8 +3712,9 @@ Perl_get_context(void) #if defined(USE_ITHREADS) # ifdef OLD_PTHREADS_API pthread_addr_t t; - if (pthread_getspecific(PL_thr_key, &t)) - Perl_croak_nocontext("panic: pthread_getspecific"); + int error = pthread_getspecific(PL_thr_key, &t) + if (error) + Perl_croak_nocontext("panic: pthread_getspecific, error=%d", error); return (void*)t; # else # ifdef I_MACH_CTHREADS @@ -3729,8 +3737,11 @@ Perl_set_context(void *t) # ifdef I_MACH_CTHREADS cthread_set_data(cthread_self(), t); # else - if (pthread_setspecific(PL_thr_key, t)) - Perl_croak_nocontext("panic: pthread_setspecific"); + { + const int error = pthread_setspecific(PL_thr_key, t); + if (error) + Perl_croak_nocontext("panic: pthread_setspecific, error=%d", error); + } # endif #else PERL_UNUSED_ARG(t); |