From: Gurusamy Sarathy <gsar@cpan.org>
Date: Mon, 20 Sep 1999 03:06:10 +0000 (+0000)
Subject: queue errors due to strictures rather than printing them as
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5a844595b9262407e093364ec4d29a22962723f0;p=p5sagit%2Fp5-mst-13.2.git

queue errors due to strictures rather than printing them as
warnings; symbols that violate strictures do *not* end up in
the symbol table anyway, making multiple evals of the same piece
of code produce the same errors; errors indicate all locations
of a global symbol rather than just the first one; these
changes make compile-time failures within evals reliably
visible via the return value or contents of $@, and trappable
using __DIE__ hooks

p4raw-id: //depot/perl@4197
---

diff --git a/embed.h b/embed.h
index 7cde885..bf92164 100644
--- a/embed.h
+++ b/embed.h
@@ -97,6 +97,7 @@
 #define die_nocontext		Perl_die_nocontext
 #define deb_nocontext		Perl_deb_nocontext
 #define form_nocontext		Perl_form_nocontext
+#define mess_nocontext		Perl_mess_nocontext
 #define warn_nocontext		Perl_warn_nocontext
 #define warner_nocontext	Perl_warner_nocontext
 #define newSVpvf_nocontext	Perl_newSVpvf_nocontext
@@ -364,6 +365,8 @@
 #define mem_collxfrm		Perl_mem_collxfrm
 #endif
 #define mess			Perl_mess
+#define vmess			Perl_vmess
+#define qerror			Perl_qerror
 #define mg_clear		Perl_mg_clear
 #define mg_copy			Perl_mg_copy
 #define mg_find			Perl_mg_find
@@ -1698,7 +1701,8 @@
 #if defined(USE_LOCALE_COLLATE)
 #define mem_collxfrm(a,b,c)	Perl_mem_collxfrm(aTHX_ a,b,c)
 #endif
-#define mess(a,b)		Perl_mess(aTHX_ a,b)
+#define vmess(a,b)		Perl_vmess(aTHX_ a,b)
+#define qerror(a)		Perl_qerror(aTHX_ a)
 #define mg_clear(a)		Perl_mg_clear(aTHX_ a)
 #define mg_copy(a,b,c,d)	Perl_mg_copy(aTHX_ a,b,c,d)
 #define mg_find(a,b)		Perl_mg_find(aTHX_ a,b)
@@ -2818,6 +2822,8 @@
 #define deb_nocontext		Perl_deb_nocontext
 #define Perl_form_nocontext	CPerlObj::Perl_form_nocontext
 #define form_nocontext		Perl_form_nocontext
+#define Perl_mess_nocontext	CPerlObj::Perl_mess_nocontext
+#define mess_nocontext		Perl_mess_nocontext
 #define Perl_warn_nocontext	CPerlObj::Perl_warn_nocontext
 #define warn_nocontext		Perl_warn_nocontext
 #define Perl_warner_nocontext	CPerlObj::Perl_warner_nocontext
@@ -3333,6 +3339,10 @@
 #endif
 #define Perl_mess		CPerlObj::Perl_mess
 #define mess			Perl_mess
+#define Perl_vmess		CPerlObj::Perl_vmess
+#define vmess			Perl_vmess
+#define Perl_qerror		CPerlObj::Perl_qerror
+#define qerror			Perl_qerror
 #define Perl_mg_clear		CPerlObj::Perl_mg_clear
 #define mg_clear		Perl_mg_clear
 #define Perl_mg_copy		CPerlObj::Perl_mg_copy
@@ -5365,6 +5375,7 @@
 #  define deb				Perl_deb_nocontext
 #  define die				Perl_die_nocontext
 #  define form				Perl_form_nocontext
+#  define mess				Perl_mess_nocontext
 #  define newSVpvf			Perl_newSVpvf_nocontext
 #  define sv_catpvf			Perl_sv_catpvf_nocontext
 #  define sv_setpvf			Perl_sv_setpvf_nocontext
@@ -5382,6 +5393,7 @@
 #  define Perl_die_nocontext		Perl_die
 #  define Perl_deb_nocontext		Perl_deb
 #  define Perl_form_nocontext		Perl_form
+#  define Perl_mess_nocontext		Perl_mess
 #  define Perl_newSVpvf_nocontext	Perl_newSVpvf
 #  define Perl_sv_catpvf_nocontext	Perl_sv_catpvf
 #  define Perl_sv_setpvf_nocontext	Perl_sv_setpvf
diff --git a/embed.pl b/embed.pl
index 85e33dd..35a53cb 100755
--- a/embed.pl
+++ b/embed.pl
@@ -492,6 +492,7 @@ print EM <<'END';
 #  define deb				Perl_deb_nocontext
 #  define die				Perl_die_nocontext
 #  define form				Perl_form_nocontext
+#  define mess				Perl_mess_nocontext
 #  define newSVpvf			Perl_newSVpvf_nocontext
 #  define sv_catpvf			Perl_sv_catpvf_nocontext
 #  define sv_setpvf			Perl_sv_setpvf_nocontext
@@ -509,6 +510,7 @@ print EM <<'END';
 #  define Perl_die_nocontext		Perl_die
 #  define Perl_deb_nocontext		Perl_deb
 #  define Perl_form_nocontext		Perl_form
+#  define Perl_mess_nocontext		Perl_mess
 #  define Perl_newSVpvf_nocontext	Perl_newSVpvf
 #  define Perl_sv_catpvf_nocontext	Perl_sv_catpvf
 #  define Perl_sv_setpvf_nocontext	Perl_sv_setpvf
@@ -843,6 +845,7 @@ my %vfuncs = qw(
     Perl_warner			Perl_vwarner
     Perl_die			Perl_vdie
     Perl_form			Perl_vform
+    Perl_mess			Perl_vmess
     Perl_deb			Perl_vdeb
     Perl_newSVpvf		Perl_vnewSVpvf
     Perl_sv_setpvf		Perl_sv_vsetpvf
@@ -871,7 +874,6 @@ sub emit_func {
 		  ? '' : 'return ');
     my $emitval = '';
     if (@args and $args[$#args] =~ /\.\.\./) {
-	pop @args;
 	pop @aargs;
 	my $retarg = '';
 	my $ctxfunc = $func;
@@ -1049,6 +1051,7 @@ npr	|void	|croak_nocontext|const char* pat|...
 np	|OP*	|die_nocontext	|const char* pat|...
 np	|void	|deb_nocontext	|const char* pat|...
 np	|char*	|form_nocontext	|const char* pat|...
+np	|SV*	|mess_nocontext	|const char* pat|...
 np	|void	|warn_nocontext	|const char* pat|...
 np	|void	|warner_nocontext|U32 err|const char* pat|...
 np	|SV*	|newSVpvf_nocontext|const char* pat|...
@@ -1326,7 +1329,9 @@ p	|void	|markstack_grow
 #if defined(USE_LOCALE_COLLATE)
 p	|char*	|mem_collxfrm	|const char* s|STRLEN len|STRLEN* xlen
 #endif
-p	|SV*	|mess		|const char* pat|va_list* args
+p	|SV*	|mess		|const char* pat|...
+p	|SV*	|vmess		|const char* pat|va_list* args
+p	|void	|qerror		|SV* err
 p	|int	|mg_clear	|SV* sv
 p	|int	|mg_copy	|SV* sv|SV* nsv|const char* key|I32 klen
 p	|MAGIC*	|mg_find	|SV* sv|int type
diff --git a/embedvar.h b/embedvar.h
index 65a31f1..5394d4d 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -51,6 +51,7 @@
 #define PL_dumpindent		(vTHX->Tdumpindent)
 #define PL_efloatbuf		(vTHX->Tefloatbuf)
 #define PL_efloatsize		(vTHX->Tefloatsize)
+#define PL_errors		(vTHX->Terrors)
 #define PL_extralen		(vTHX->Textralen)
 #define PL_firstgv		(vTHX->Tfirstgv)
 #define PL_formtarget		(vTHX->Tformtarget)
@@ -1000,6 +1001,7 @@
 #define PL_dumpindent		(aTHX->Tdumpindent)
 #define PL_efloatbuf		(aTHX->Tefloatbuf)
 #define PL_efloatsize		(aTHX->Tefloatsize)
+#define PL_errors		(aTHX->Terrors)
 #define PL_extralen		(aTHX->Textralen)
 #define PL_firstgv		(aTHX->Tfirstgv)
 #define PL_formtarget		(aTHX->Tformtarget)
@@ -1136,6 +1138,7 @@
 #define PL_Tdumpindent		PL_dumpindent
 #define PL_Tefloatbuf		PL_efloatbuf
 #define PL_Tefloatsize		PL_efloatsize
+#define PL_Terrors		PL_errors
 #define PL_Textralen		PL_extralen
 #define PL_Tfirstgv		PL_firstgv
 #define PL_Tformtarget		PL_formtarget
diff --git a/ext/DynaLoader/dlutils.c b/ext/DynaLoader/dlutils.c
index 6da5323..7391156 100644
--- a/ext/DynaLoader/dlutils.c
+++ b/ext/DynaLoader/dlutils.c
@@ -55,7 +55,7 @@ SaveError(pTHXo_ char* pat, ...)
     /* This code is based on croak/warn, see mess() in util.c */
 
     va_start(args, pat);
-    msv = mess(pat, &args);
+    msv = vmess(pat, &args);
     va_end(args);
 
     message = SvPV(msv,len);
diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs
index 772d41a..e01f29d 100644
--- a/ext/Thread/Thread.xs
+++ b/ext/Thread/Thread.xs
@@ -181,6 +181,7 @@ threadstart(void *arg)
     SvREFCNT_dec(PL_rs);
     SvREFCNT_dec(PL_nrs);
     SvREFCNT_dec(PL_statname);
+    SvREFCNT_dec(PL_errors);
     Safefree(PL_screamfirst);
     Safefree(PL_screamnext);
     Safefree(PL_reg_start_tmp);
diff --git a/global.sym b/global.sym
index 5ee74d7..7200c60 100644
--- a/global.sym
+++ b/global.sym
@@ -48,6 +48,7 @@ Perl_croak_nocontext
 Perl_die_nocontext
 Perl_deb_nocontext
 Perl_form_nocontext
+Perl_mess_nocontext
 Perl_warn_nocontext
 Perl_warner_nocontext
 Perl_newSVpvf_nocontext
@@ -296,6 +297,8 @@ Perl_malloced_size
 Perl_markstack_grow
 Perl_mem_collxfrm
 Perl_mess
+Perl_vmess
+Perl_qerror
 Perl_mg_clear
 Perl_mg_copy
 Perl_mg_find
diff --git a/gv.c b/gv.c
index ae76f82..29131ee 100644
--- a/gv.c
+++ b/gv.c
@@ -568,26 +568,15 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
     /* By this point we should have a stash and a name */
 
     if (!stash) {
-	if (!add)
-	    return Nullgv;
-	{
-	    char sv_type_char = ((sv_type == SVt_PV) ? '$'
-				 : (sv_type == SVt_PVAV) ? '@'
-				 : (sv_type == SVt_PVHV) ? '%'
-				 : 0);
-	    if (sv_type_char) 
-		Perl_warn(aTHX_ "Global symbol \"%c%s\" requires explicit package name",
-		     sv_type_char, name);
-	    else
-		Perl_warn(aTHX_ "Global symbol \"%s\" requires explicit package name",
-		     name);
+	if (add) {
+	    qerror(Perl_mess(aTHX_
+		 "Global symbol \"%s%s\" requires explicit package name",
+		 (sv_type == SVt_PV ? "$"
+		  : sv_type == SVt_PVAV ? "@"
+		  : sv_type == SVt_PVHV ? "%"
+		  : ""), name));
 	}
-	++PL_error_count;
-	stash = PL_curstash ? PL_curstash : PL_defstash;	/* avoid core dumps */
-	add_gvflags = ((sv_type == SVt_PV) ? GVf_IMPORTED_SV
-		       : (sv_type == SVt_PVAV) ? GVf_IMPORTED_AV
-		       : (sv_type == SVt_PVHV) ? GVf_IMPORTED_HV
-		       : 0);
+	return Nullgv;
     }
 
     if (!SvREFCNT(stash))	/* symbol table under destruction */
diff --git a/objXSUB.h b/objXSUB.h
index 5da23fe..6614162 100644
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -580,6 +580,8 @@
 #define PL_efloatbuf		(*Perl_Tefloatbuf_ptr(aTHXo))
 #undef  PL_efloatsize
 #define PL_efloatsize		(*Perl_Tefloatsize_ptr(aTHXo))
+#undef  PL_errors
+#define PL_errors		(*Perl_Terrors_ptr(aTHXo))
 #undef  PL_extralen
 #define PL_extralen		(*Perl_Textralen_ptr(aTHXo))
 #undef  PL_firstgv
@@ -1004,6 +1006,10 @@
 #define Perl_form_nocontext	pPerl->Perl_form_nocontext
 #undef  form_nocontext
 #define form_nocontext		Perl_form_nocontext
+#undef  Perl_mess_nocontext
+#define Perl_mess_nocontext	pPerl->Perl_mess_nocontext
+#undef  mess_nocontext
+#define mess_nocontext		Perl_mess_nocontext
 #undef  Perl_warn_nocontext
 #define Perl_warn_nocontext	pPerl->Perl_warn_nocontext
 #undef  warn_nocontext
@@ -2015,6 +2021,14 @@
 #define Perl_mess		pPerl->Perl_mess
 #undef  mess
 #define mess			Perl_mess
+#undef  Perl_vmess
+#define Perl_vmess		pPerl->Perl_vmess
+#undef  vmess
+#define vmess			Perl_vmess
+#undef  Perl_qerror
+#define Perl_qerror		pPerl->Perl_qerror
+#undef  qerror
+#define qerror			Perl_qerror
 #undef  Perl_mg_clear
 #define Perl_mg_clear		pPerl->Perl_mg_clear
 #undef  mg_clear
diff --git a/op.c b/op.c
index 0053bdd..788464f 100644
--- a/op.c
+++ b/op.c
@@ -96,9 +96,9 @@ S_bad_type(pTHX_ I32 n, char *t, char *name, OP *kid)
 STATIC void
 S_no_bareword_allowed(pTHX_ OP *o)
 {
-    Perl_warn(aTHX_ "Bareword \"%s\" not allowed while \"strict subs\" in use",
-	  SvPV_nolen(cSVOPo->op_sv));
-    ++PL_error_count;
+    qerror(Perl_mess(aTHX_
+		     "Bareword \"%s\" not allowed while \"strict subs\" in use",
+		     SvPV_nolen(cSVOPo->op_sv)));
 }
 
 /* "register" allocation */
diff --git a/perl.c b/perl.c
index de91ed4..c7cbe7e 100644
--- a/perl.c
+++ b/perl.c
@@ -443,6 +443,10 @@ perl_destruct(pTHXx)
     PL_defstash = 0;
     SvREFCNT_dec(hv);
 
+    /* clear queued errors */
+    SvREFCNT_dec(PL_errors);
+    PL_errors = Nullsv;
+
     FREETMPS;
     if (destruct_level >= 2 && ckWARN_d(WARN_INTERNAL)) {
 	if (PL_scopestack_ix != 0)
diff --git a/perlapi.c b/perlapi.c
index ed7ab92..0f20e54 100644
--- a/perlapi.c
+++ b/perlapi.c
@@ -314,7 +314,7 @@ Perl_convert(pTHXo_ I32 optype, I32 flags, OP* o)
 
 #undef  Perl_croak
 void
-Perl_croak(pTHXo_ const char* pat)
+Perl_croak(pTHXo_ const char* pat, ...)
 {
     va_list args;
     va_start(args, pat);
@@ -332,7 +332,7 @@ Perl_vcroak(pTHXo_ const char* pat, va_list* args)
 
 #undef  Perl_croak_nocontext
 void
-Perl_croak_nocontext(const char* pat)
+Perl_croak_nocontext(const char* pat, ...)
 {
     dTHXo;
     va_list args;
@@ -343,7 +343,7 @@ Perl_croak_nocontext(const char* pat)
 
 #undef  Perl_die_nocontext
 OP*
-Perl_die_nocontext(const char* pat)
+Perl_die_nocontext(const char* pat, ...)
 {
     dTHXo;
     OP* retval;
@@ -357,7 +357,7 @@ Perl_die_nocontext(const char* pat)
 
 #undef  Perl_deb_nocontext
 void
-Perl_deb_nocontext(const char* pat)
+Perl_deb_nocontext(const char* pat, ...)
 {
     dTHXo;
     va_list args;
@@ -368,7 +368,7 @@ Perl_deb_nocontext(const char* pat)
 
 #undef  Perl_form_nocontext
 char*
-Perl_form_nocontext(const char* pat)
+Perl_form_nocontext(const char* pat, ...)
 {
     dTHXo;
     char* retval;
@@ -380,9 +380,23 @@ Perl_form_nocontext(const char* pat)
 
 }
 
+#undef  Perl_mess_nocontext
+SV*
+Perl_mess_nocontext(const char* pat, ...)
+{
+    dTHXo;
+    SV* retval;
+    va_list args;
+    va_start(args, pat);
+    retval = ((CPerlObj*)pPerl)->Perl_vmess(pat, &args);
+    va_end(args);
+    return retval;
+
+}
+
 #undef  Perl_warn_nocontext
 void
-Perl_warn_nocontext(const char* pat)
+Perl_warn_nocontext(const char* pat, ...)
 {
     dTHXo;
     va_list args;
@@ -393,7 +407,7 @@ Perl_warn_nocontext(const char* pat)
 
 #undef  Perl_warner_nocontext
 void
-Perl_warner_nocontext(U32 err, const char* pat)
+Perl_warner_nocontext(U32 err, const char* pat, ...)
 {
     dTHXo;
     va_list args;
@@ -404,7 +418,7 @@ Perl_warner_nocontext(U32 err, const char* pat)
 
 #undef  Perl_newSVpvf_nocontext
 SV*
-Perl_newSVpvf_nocontext(const char* pat)
+Perl_newSVpvf_nocontext(const char* pat, ...)
 {
     dTHXo;
     SV* retval;
@@ -418,7 +432,7 @@ Perl_newSVpvf_nocontext(const char* pat)
 
 #undef  Perl_sv_catpvf_nocontext
 void
-Perl_sv_catpvf_nocontext(SV* sv, const char* pat)
+Perl_sv_catpvf_nocontext(SV* sv, const char* pat, ...)
 {
     dTHXo;
     va_list args;
@@ -429,7 +443,7 @@ Perl_sv_catpvf_nocontext(SV* sv, const char* pat)
 
 #undef  Perl_sv_setpvf_nocontext
 void
-Perl_sv_setpvf_nocontext(SV* sv, const char* pat)
+Perl_sv_setpvf_nocontext(SV* sv, const char* pat, ...)
 {
     dTHXo;
     va_list args;
@@ -440,7 +454,7 @@ Perl_sv_setpvf_nocontext(SV* sv, const char* pat)
 
 #undef  Perl_sv_catpvf_mg_nocontext
 void
-Perl_sv_catpvf_mg_nocontext(SV* sv, const char* pat)
+Perl_sv_catpvf_mg_nocontext(SV* sv, const char* pat, ...)
 {
     dTHXo;
     va_list args;
@@ -451,7 +465,7 @@ Perl_sv_catpvf_mg_nocontext(SV* sv, const char* pat)
 
 #undef  Perl_sv_setpvf_mg_nocontext
 void
-Perl_sv_setpvf_mg_nocontext(SV* sv, const char* pat)
+Perl_sv_setpvf_mg_nocontext(SV* sv, const char* pat, ...)
 {
     dTHXo;
     va_list args;
@@ -570,7 +584,7 @@ Perl_cxinc(pTHXo)
 
 #undef  Perl_deb
 void
-Perl_deb(pTHXo_ const char* pat)
+Perl_deb(pTHXo_ const char* pat, ...)
 {
     va_list args;
     va_start(args, pat);
@@ -636,7 +650,7 @@ Perl_deprecate(pTHXo_ char* s)
 
 #undef  Perl_die
 OP*
-Perl_die(pTHXo_ const char* pat)
+Perl_die(pTHXo_ const char* pat, ...)
 {
     OP* retval;
     va_list args;
@@ -1014,7 +1028,7 @@ Perl_fold_constants(pTHXo_ OP* arg)
 
 #undef  Perl_form
 char*
-Perl_form(pTHXo_ const char* pat)
+Perl_form(pTHXo_ const char* pat, ...)
 {
     char* retval;
     va_list args;
@@ -2172,9 +2186,29 @@ Perl_mem_collxfrm(pTHXo_ const char* s, STRLEN len, STRLEN* xlen)
 
 #undef  Perl_mess
 SV*
-Perl_mess(pTHXo_ const char* pat, va_list* args)
+Perl_mess(pTHXo_ const char* pat, ...)
+{
+    SV* retval;
+    va_list args;
+    va_start(args, pat);
+    retval = ((CPerlObj*)pPerl)->Perl_vmess(pat, &args);
+    va_end(args);
+    return retval;
+
+}
+
+#undef  Perl_vmess
+SV*
+Perl_vmess(pTHXo_ const char* pat, va_list* args)
+{
+    return ((CPerlObj*)pPerl)->Perl_vmess(pat, args);
+}
+
+#undef  Perl_qerror
+void
+Perl_qerror(pTHXo_ SV* err)
 {
-    return ((CPerlObj*)pPerl)->Perl_mess(pat, args);
+    ((CPerlObj*)pPerl)->Perl_qerror(err);
 }
 
 #undef  Perl_mg_clear
@@ -2688,7 +2722,7 @@ Perl_newSVpvn(pTHXo_ const char* s, STRLEN len)
 
 #undef  Perl_newSVpvf
 SV*
-Perl_newSVpvf(pTHXo_ const char* pat)
+Perl_newSVpvf(pTHXo_ const char* pat, ...)
 {
     SV* retval;
     va_list args;
@@ -3713,7 +3747,7 @@ Perl_sv_bless(pTHXo_ SV* sv, HV* stash)
 
 #undef  Perl_sv_catpvf
 void
-Perl_sv_catpvf(pTHXo_ SV* sv, const char* pat)
+Perl_sv_catpvf(pTHXo_ SV* sv, const char* pat, ...)
 {
     va_list args;
     va_start(args, pat);
@@ -3991,7 +4025,7 @@ Perl_sv_reset(pTHXo_ char* s, HV* stash)
 
 #undef  Perl_sv_setpvf
 void
-Perl_sv_setpvf(pTHXo_ SV* sv, const char* pat)
+Perl_sv_setpvf(pTHXo_ SV* sv, const char* pat, ...)
 {
     va_list args;
     va_start(args, pat);
@@ -4299,7 +4333,7 @@ Perl_wait4pid(pTHXo_ Pid_t pid, int* statusp, int flags)
 
 #undef  Perl_warn
 void
-Perl_warn(pTHXo_ const char* pat)
+Perl_warn(pTHXo_ const char* pat, ...)
 {
     va_list args;
     va_start(args, pat);
@@ -4316,7 +4350,7 @@ Perl_vwarn(pTHXo_ const char* pat, va_list* args)
 
 #undef  Perl_warner
 void
-Perl_warner(pTHXo_ U32 err, const char* pat)
+Perl_warner(pTHXo_ U32 err, const char* pat, ...)
 {
     va_list args;
     va_start(args, pat);
@@ -4515,7 +4549,7 @@ Perl_runops_debug(pTHXo)
 
 #undef  Perl_sv_catpvf_mg
 void
-Perl_sv_catpvf_mg(pTHXo_ SV *sv, const char* pat)
+Perl_sv_catpvf_mg(pTHXo_ SV *sv, const char* pat, ...)
 {
     va_list args;
     va_start(args, pat);
@@ -4553,7 +4587,7 @@ Perl_sv_catsv_mg(pTHXo_ SV *dstr, SV *sstr)
 
 #undef  Perl_sv_setpvf_mg
 void
-Perl_sv_setpvf_mg(pTHXo_ SV *sv, const char* pat)
+Perl_sv_setpvf_mg(pTHXo_ SV *sv, const char* pat, ...)
 {
     va_list args;
     va_start(args, pat);
@@ -4640,7 +4674,7 @@ Perl_pv_display(pTHXo_ SV *sv, char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
 
 #undef  Perl_dump_indent
 void
-Perl_dump_indent(pTHXo_ I32 level, PerlIO *file, const char* pat)
+Perl_dump_indent(pTHXo_ I32 level, PerlIO *file, const char* pat, ...)
 {
     va_list args;
     va_start(args, pat);
@@ -4713,7 +4747,7 @@ Perl_magic_dump(pTHXo_ MAGIC *mg)
 
 #undef  Perl_default_protect
 void*
-Perl_default_protect(pTHXo_ int *excpt, protect_body_t body)
+Perl_default_protect(pTHXo_ int *excpt, protect_body_t body, ...)
 {
     void* retval;
     va_list args;
diff --git a/pp_ctl.c b/pp_ctl.c
index caaaf20..07c3e74 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1247,6 +1247,18 @@ S_free_closures(pTHX)
     }
 }
 
+void
+Perl_qerror(pTHX_ SV *err)
+{
+    if (PL_in_eval)
+	sv_catsv(ERRSV, err);
+    else if (PL_errors)
+	sv_catsv(PL_errors, err);
+    else
+	Perl_warn(aTHX_ "%_", err);
+    ++PL_error_count;
+}
+
 OP *
 Perl_die_where(pTHX_ char *message, STRLEN msglen)
 {
@@ -1288,7 +1300,9 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen)
 	else
 	    message = SvPVx(ERRSV, msglen);
 
-	while ((cxix = dopoptoeval(cxstack_ix)) < 0 && PL_curstackinfo->si_prev) {
+	while ((cxix = dopoptoeval(cxstack_ix)) < 0
+	       && PL_curstackinfo->si_prev)
+	{
 	    dounwind(-1);
 	    POPSTACK;
 	}
@@ -1315,7 +1329,8 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen)
 
 	    if (optype == OP_REQUIRE) {
 		char* msg = SvPVx(ERRSV, n_a);
-		DIE(aTHX_ "%s", *msg ? msg : "Compilation failed in require");
+		DIE(aTHX_ "%sCompilation failed in require",
+		    *msg ? msg : "Unknown error\n");
 	    }
 	    return pop_return();
 	}
@@ -2625,13 +2640,16 @@ S_doeval(pTHX_ int gimme, OP** startop)
 	LEAVE;
 	if (optype == OP_REQUIRE) {
 	    char* msg = SvPVx(ERRSV, n_a);
-	    DIE(aTHX_ "%s", *msg ? msg : "Compilation failed in require");
-	} else if (startop) {
+	    DIE(aTHX_ "%sCompilation failed in require",
+		*msg ? msg : "Unknown error\n");
+	}
+	else if (startop) {
 	    char* msg = SvPVx(ERRSV, n_a);
 
 	    POPBLOCK(cx,PL_curpm);
 	    POPEVAL(cx);
-	    Perl_croak(aTHX_ "%sCompilation failed in regexp", (*msg ? msg : "Unknown error\n"));
+	    Perl_croak(aTHX_ "%sCompilation failed in regexp",
+		       (*msg ? msg : "Unknown error\n"));
 	}
 	SvREFCNT_dec(PL_rs);
 	PL_rs = SvREFCNT_inc(PL_nrs);
diff --git a/proto.h b/proto.h
index 38c7ce6..74958d3 100644
--- a/proto.h
+++ b/proto.h
@@ -56,6 +56,7 @@ VIRTUAL void	Perl_croak_nocontext(const char* pat, ...) __attribute__((noreturn)
 VIRTUAL OP*	Perl_die_nocontext(const char* pat, ...);
 VIRTUAL void	Perl_deb_nocontext(const char* pat, ...);
 VIRTUAL char*	Perl_form_nocontext(const char* pat, ...);
+VIRTUAL SV*	Perl_mess_nocontext(const char* pat, ...);
 VIRTUAL void	Perl_warn_nocontext(const char* pat, ...);
 VIRTUAL void	Perl_warner_nocontext(U32 err, const char* pat, ...);
 VIRTUAL SV*	Perl_newSVpvf_nocontext(const char* pat, ...);
@@ -322,7 +323,9 @@ VIRTUAL void	Perl_markstack_grow(pTHX);
 #if defined(USE_LOCALE_COLLATE)
 VIRTUAL char*	Perl_mem_collxfrm(pTHX_ const char* s, STRLEN len, STRLEN* xlen);
 #endif
-VIRTUAL SV*	Perl_mess(pTHX_ const char* pat, va_list* args);
+VIRTUAL SV*	Perl_mess(pTHX_ const char* pat, ...);
+VIRTUAL SV*	Perl_vmess(pTHX_ const char* pat, va_list* args);
+VIRTUAL void	Perl_qerror(pTHX_ SV* err);
 VIRTUAL int	Perl_mg_clear(pTHX_ SV* sv);
 VIRTUAL int	Perl_mg_copy(pTHX_ SV* sv, SV* nsv, const char* key, I32 klen);
 VIRTUAL MAGIC*	Perl_mg_find(pTHX_ SV* sv, int type);
diff --git a/regcomp.c b/regcomp.c
index ed1b3bd..ceab482 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -3395,7 +3395,7 @@ S_re_croak2(pTHX_ const char* pat1,const char* pat2,...)
 #else
     va_start(args);
 #endif
-    msv = mess(buf, &args);
+    msv = vmess(buf, &args);
     va_end(args);
     message = SvPV(msv,l1);
     if (l1 > 512)
diff --git a/t/pragma/strict-refs b/t/pragma/strict-refs
index 7bf1556..10599b0 100644
--- a/t/pragma/strict-refs
+++ b/t/pragma/strict-refs
@@ -196,6 +196,7 @@ ${"Fred"} ;
 require "./abc";
 EXPECT
 Can't use string ("Fred") as a SCALAR ref while "strict refs" in use at ./abc line 2.
+Compilation failed in require at - line 2.
 ########
 
 --FILE-- abc.pm
@@ -207,6 +208,7 @@ my $a = ${"Fred"} ;
 use abc;
 EXPECT
 Can't use string ("Fred") as a SCALAR ref while "strict refs" in use at abc.pm line 2.
+Compilation failed in require at - line 2.
 BEGIN failed--compilation aborted at - line 2.
 ########
 
diff --git a/t/pragma/strict-vars b/t/pragma/strict-vars
index 42107fa..3e3e0e3 100644
--- a/t/pragma/strict-vars
+++ b/t/pragma/strict-vars
@@ -165,6 +165,7 @@ print STDERR $@;
 $joe = 1 ;
 EXPECT
 Global symbol "$joe" requires explicit package name at - line 5.
+Global symbol "$joe" requires explicit package name at - line 8.
 Execution of - aborted due to compilation errors.
 ########
 
@@ -221,3 +222,18 @@ $joe = 1 ;
 EXPECT
 Global symbol "$joe" requires explicit package name at - line 8.
 Execution of - aborted due to compilation errors.
+########
+
+# Check if multiple evals produce same errors
+use strict 'vars';
+my $ret = eval q{ print $x; };
+print $@;
+print "ok 1\n" unless defined $ret;
+$ret = eval q{ print $x; };
+print $@;
+print "ok 2\n" unless defined $ret;
+EXPECT
+Global symbol "$x" requires explicit package name at (eval 1) line 1.
+ok 1
+Global symbol "$x" requires explicit package name at (eval 2) line 1.
+ok 2
diff --git a/thrdvar.h b/thrdvar.h
index 06bcb5b..2b64b7e 100644
--- a/thrdvar.h
+++ b/thrdvar.h
@@ -101,6 +101,7 @@ PERLVAR(Tmainstack,	AV *)		/* the stack when nothing funny is happening */
 PERLVAR(Ttop_env,	JMPENV *)	/* ptr. to current sigjmp() environment */
 PERLVAR(Tstart_env,	JMPENV)		/* empty startup sigjmp() environment */
 PERLVARI(Tprotect,	protect_proc_t,	MEMBER_TO_FPTR(Perl_default_protect))
+PERLVARI(Terrors,	SV *, Nullsv)	/* outstanding queued errors */
 
 /* statics "owned" by various functions */
 PERLVAR(Tav_fetch_sv,	SV *)		/* owned by av_fetch() */
diff --git a/toke.c b/toke.c
index 3c098a2..5280054 100644
--- a/toke.c
+++ b/toke.c
@@ -6897,7 +6897,6 @@ int
 Perl_yywarn(pTHX_ char *s)
 {
     dTHR;
-    --PL_error_count;
     PL_in_eval |= EVAL_WARNONLY;
     yyerror(s);
     PL_in_eval &= ~EVAL_WARNONLY;
@@ -6977,11 +6976,9 @@ PRId64 ")\n",
     }
     if (PL_in_eval & EVAL_WARNONLY)
 	Perl_warn(aTHX_ "%_", msg);
-    else if (PL_in_eval)
-	sv_catsv(ERRSV, msg);
     else
-	PerlIO_write(PerlIO_stderr(), SvPVX(msg), SvCUR(msg));
-    if (++PL_error_count >= 10)
+	qerror(msg);
+    if (PL_error_count >= 10)
 	Perl_croak(aTHX_ "%_ has too many errors.\n", GvSV(PL_curcop->cop_filegv));
     PL_in_my = 0;
     PL_in_my_stash = Nullhv;
diff --git a/util.c b/util.c
index 552c092..a92c4db 100644
--- a/util.c
+++ b/util.c
@@ -1379,8 +1379,33 @@ Perl_vform(pTHX_ const char *pat, va_list *args)
     return SvPVX(sv);
 }
 
+#if defined(PERL_IMPLICIT_CONTEXT)
+SV *
+Perl_mess_nocontext(const char *pat, ...)
+{
+    dTHX;
+    SV *retval;
+    va_list args;
+    va_start(args, pat);
+    retval = vmess(pat, &args);
+    va_end(args);
+    return retval;
+}
+#endif /* PERL_IMPLICIT_CONTEXT */
+
 SV *
-Perl_mess(pTHX_ const char *pat, va_list *args)
+Perl_mess(pTHX_ const char *pat, ...)
+{
+    SV *retval;
+    va_list args;
+    va_start(args, pat);
+    retval = vmess(pat, &args);
+    va_end(args);
+    return retval;
+}
+
+SV *
+Perl_vmess(pTHX_ const char *pat, va_list *args)
 {
     SV *sv = mess_alloc();
     static char dgd[] = " during global destruction.\n";
@@ -1438,8 +1463,14 @@ Perl_vdie(pTHX_ const char* pat, va_list *args)
 			  thr, PL_curstack, PL_mainstack));
 
     if (pat) {
-	msv = mess(pat, args);
-	message = SvPV(msv,msglen);
+	msv = vmess(pat, args);
+	if (PL_errors && SvCUR(PL_errors)) {
+	    sv_catsv(PL_errors, msv);
+	    message = SvPV(PL_errors, msglen);
+	    SvCUR_set(PL_errors, 0);
+	}
+	else
+	    message = SvPV(msv,msglen);
     }
     else {
 	message = Nullch;
@@ -1529,9 +1560,18 @@ Perl_vcroak(pTHX_ const char* pat, va_list *args)
     SV *msv;
     STRLEN msglen;
 
-    msv = mess(pat, args);
-    message = SvPV(msv,msglen);
-    DEBUG_S(PerlIO_printf(PerlIO_stderr(), "croak: 0x%lx %s", (unsigned long) thr, message));
+    msv = vmess(pat, args);
+    if (PL_errors && SvCUR(PL_errors)) {
+	sv_catsv(PL_errors, msv);
+	message = SvPV(PL_errors, msglen);
+	SvCUR_set(PL_errors, 0);
+    }
+    else
+	message = SvPV(msv,msglen);
+
+    DEBUG_S(PerlIO_printf(PerlIO_stderr(), "croak: 0x%lx %s",
+			  (unsigned long) thr, message));
+
     if (PL_diehook) {
 	/* sv_2cv might call Perl_croak() */
 	SV *olddiehook = PL_diehook;
@@ -1609,7 +1649,7 @@ Perl_vwarn(pTHX_ const char* pat, va_list *args)
     SV *msv;
     STRLEN msglen;
 
-    msv = mess(pat, args);
+    msv = vmess(pat, args);
     message = SvPV(msv, msglen);
 
     if (PL_warnhook) {
@@ -1705,7 +1745,7 @@ Perl_vwarner(pTHX_ U32  err, const char* pat, va_list* args)
     SV *msv;
     STRLEN msglen;
 
-    msv = mess(pat, args);
+    msv = vmess(pat, args);
     message = SvPV(msv, msglen);
 
     if (ckDEAD(err)) {
@@ -3370,6 +3410,7 @@ Perl_new_struct_thread(pTHX_ struct perl_thread *t)
     PL_restartop = 0;
 
     PL_statname = NEWSV(66,0);
+    PL_errors = newSVpvn("", 0);
     PL_maxscream = -1;
     PL_regcompp = MEMBER_TO_FPTR(Perl_pregcomp);
     PL_regexecp = MEMBER_TO_FPTR(Perl_regexec_flags);