From: Nicholas Clark <nick@ccl4.org>
Date: Sun, 29 Nov 2009 19:02:05 +0000 (+0000)
Subject: Handle $@ being assigned a read-only value (without error or busting the stack).
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=dfd167e94af611f6248e804cb228b35ca4123bd6;p=p5sagit%2Fp5-mst-13.2.git

Handle $@ being assigned a read-only value (without error or busting the stack).

Discovered whilst investigating RT #70862.
---

diff --git a/perl.h b/perl.h
index 2f02ba4..adff169 100644
--- a/perl.h
+++ b/perl.h
@@ -1311,6 +1311,24 @@ EXTERN_C char *crypt(const char *, const char *);
 #endif
 
 #define ERRSV GvSVn(PL_errgv)
+
+#define CLEAR_ERRSV() STMT_START {					\
+    if (!GvSV(PL_errgv)) {						\
+	sv_setpvs(GvSV(gv_add_by_type(PL_errgv, SVt_PV)), "");		\
+    } else if (SvREADONLY(GvSV(PL_errgv))) {				\
+	SvREFCNT_dec(GvSV(PL_errgv));					\
+	GvSV(PL_errgv) = newSVpvs("");					\
+    } else {								\
+	SV *const errsv = GvSV(PL_errgv);				\
+	sv_setpvs(errsv, "");						\
+	if (SvMAGICAL(errsv)) {						\
+	    mg_free(errsv);						\
+	}								\
+	SvPOK_only(errsv);						\
+    }									\
+    } STMT_END
+
+
 #ifdef PERL_CORE
 # define DEFSV (0 + GvSVn(PL_defgv))
 #else
@@ -6129,8 +6147,6 @@ extern void moncontrol(int);
 
 #endif /* Include guard */
 
-#define CLEAR_ERRSV() STMT_START { sv_setpvn(ERRSV,"",0); if (SvMAGICAL(ERRSV)) { mg_free(ERRSV); } SvPOK_only(ERRSV); } STMT_END
-
 /*
  * Local variables:
  * c-indentation-style: bsd
diff --git a/t/op/eval.t b/t/op/eval.t
index 4daf0b9..58a6334 100644
--- a/t/op/eval.t
+++ b/t/op/eval.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-print "1..101\n";
+print "1..103\n";
 
 eval 'print "ok 1\n";';
 
@@ -572,3 +572,16 @@ eval {
 };
 print "ok\n";
 EOP
+
+fresh_perl_is(<<'EOP', "ok\n", undef, 'related to RT #70862');
+$::{'@'}=\3;
+eval {};
+print "ok\n";
+EOP
+
+fresh_perl_is(<<'EOP', "ok\n", undef, 'related to RT #70862');
+eval {
+    $::{'@'}=\3;
+};
+print "ok\n";
+EOP