Provide as much diagnostic information as possible in "panic: ..." me…

…ssages.

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.

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_END
 

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 always
 

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);

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");
 

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;
 	}

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,19 +3571,19 @@ 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.
 
 =item panic: kid popen errno read
 
 (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,20 +3603,20 @@ 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.
 
 =item panic: memory wrap
 
 (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.
 

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 &&

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;
 	    }

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;

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 {

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);
 		}