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 (file)
--- 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 (file)
--- 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