ArchiveOrangemail archive

perl5-changes.perl.org


(List home) (Recent threads) (77 other Perl lists)

Subscription Options

  • RSS or Atom: Read-only subscription using a browser or aggregator. This is the recommended way if you don't need to send messages to the list. You can learn more about feed syndication and clients here.
  • Conventional: All messages are delivered to your mail address, and you can reply. To subscribe, send an email to the list's subscribe address with "subscribe" in the subject line.
  • Moderate traffic list: up to 30 messages per day
  • This list contains about 16,851 messages, beginning Nov 2009
  • 9 messages added yesterday
Report the Spam
This button sends a spam report to the moderator. Please use it sparingly. For other removal requests, read this.
Are you sure? yes no

branch blead, updated. v5.15.6-568-g5637ef5

Ad
Nicholas Clark 1326752666Mon, 16 Jan 2012 22:24:26 +0000 (UTC)
In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff...>

- Log -----------------------------------------------------------------
commit 5637ef5b34a3e8caf72080387a15ea8d81b61baf
Author: Nicholas Clark 
Date:   Mon Jan 16 17:08:38 2012 +0100

    Provide as much diagnostic information as possible in "panic: ..." messages.
    
    The convention is that when the interpreter dies with an internal error, the
    message starts "panic: ". Historically, many panic messages had been terse
    fixed strings, which means that the out-of-range values that triggered the
    panic are lost. Now we try to report these values, as such panics may not be
    repeatable, and the original error message may be the only diagnostic we get
    when we try to find the cause.
    
    We can't report diagnostics when the panic message is generated by something
    other than croak(), as we don't have *printf-style format strings. Don't
    attempt to report values in panics related to *printf buffer overflows, as
    attempting to format the values to strings may repeat or compound the
    original error.-----------------------------------------------------------------------

Summary of changes:
 cop.h            |    2 +-
 doio.c           |    3 ++-
 op.c             |   10 ++++++----
 pad.c            |   12 ++++++++----
 perl.c           |    4 ++--
 pod/perldiag.pod |   42 +++++++++++++++++++++---------------------
 pp.c             |    2 +-
 pp_ctl.c         |    7 ++++---
 pp_hot.c         |    9 ++++++---
 pp_pack.c        |   11 ++++++++---
 pp_sys.c         |    2 +-
 regcomp.c        |   13 +++++++++----
 regexec.c        |    3 ++-
 scope.c          |    4 ++--
 sv.c             |    9 ++++++---
 toke.c           |   17 +++++++++++------
 utf8.c           |   22 ++++++++++++++++------
 util.c           |   39 +++++++++++++++++++++++++--------------
 18 files changed, 131 insertions(+), 80 deletions(-)

diff --git a/cop.h b/cop.h
index 626feee..c2f7d34 100644
--- a/cop.h
+++ b/cop.h
@@ -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_ENDdiff --git a/doio.c b/doio.c
index 1a03103..08a15b7 100644
--- a/doio.c
+++ b/doio.c
@@ -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 alwaysdiff --git a/op.c b/op.c
index d4dcf53..12f0cbc 100644
--- a/op.c
+++ b/op.c
@@ -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);
diff --git a/pad.c b/pad.c
index b67722f..779e6d6 100644
--- a/pad.c
+++ b/pad.c
@@ -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");diff --git a/perl.c b/perl.c
index 2879511..c8e8bfb 100644
--- a/perl.c
+++ b/perl.c
@@ -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 544a9ed..9263de2 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.diff --git a/pp.c b/pp.c
index eaf6a85..b54b3ab 100644
--- a/pp.c
+++ b/pp.c
@@ -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 &&
diff --git a/pp_ctl.c b/pp_ctl.c
index ce349bd..038eae0 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -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;
 	    }
diff --git a/pp_hot.c b/pp_hot.c
index a66a690..f631640 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -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;
diff --git a/pp_pack.c b/pp_pack.c
index c62754f..273908c 100644
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -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 {
diff --git a/pp_sys.c b/pp_sys.c
index d22c578..c804958 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -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);
 		}
diff --git a/regcomp.c b/regcomp.c
index 6e7bb3e..c8a6e96 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -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;
diff --git a/regexec.c b/regexec.c
index 1bb0cea..5eb6a2b 100644
--- a/regexec.c
+++ b/regexec.c
@@ -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
diff --git a/scope.c b/scope.c
index fbd92a9..cc207c0 100644
--- a/scope.c
+++ b/scope.c
@@ -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);
 	}
     }diff --git a/sv.c b/sv.c
index 1fc5459..dff1607 100644
--- a/sv.c
+++ b/sv.c
@@ -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;diff --git a/toke.c b/toke.c
index fa4c9c9..baa21d6 100644
--- a/toke.c
+++ b/toke.c
@@ -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. */
diff --git a/utf8.c b/utf8.c
index 5768f66..0014521 100644
--- a/utf8.c
+++ b/utf8.c
@@ -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. */
diff --git a/util.c b/util.c
index bdfdfdc..7ab0df7 100644
--- a/util.c
+++ b/util.c
@@ -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);
Home | About | Privacy