- Log -----------------------------------------------------------------
commit dfd167e94af611f6248e804cb228b35ca4123bd6
Author: Nicholas Clark <ni...@ccl4.org>
Date: Sun Nov 29 19:02:05 2009 +0000
Handle $@ being assigned a read-only value (without error or busting the stack).
Discovered whilst investigating RT #70862.
M perl.h
M t/op/eval.t
commit f5fa9033b8c1fdcbd7710850b3b0380d6b937853
Author: Nicholas Clark <ni...@ccl4.org>
Date: Sun Nov 29 16:42:42 2009 +0000
Fix RT #70862 by converting ERRSV to GvSVn() to ensure a non-NULL GvSV().
M perl.h
M t/op/eval.t
-----------------------------------------------------------------------
Summary of changes:
perl.h | 22 +++++++++++++++++++---
t/op/eval.t | 30 +++++++++++++++++++++++++++++-
2 files changed, 48 insertions(+), 4 deletions(-)
diff --git a/perl.h b/perl.h
index bf49279..adff169 100644
--- a/perl.h
+++ b/perl.h
@@ -1310,7 +1310,25 @@ EXTERN_C char *crypt(const char *, const char *);
# define SS_NORMAL 0
#endif
-#define ERRSV GvSV(PL_errgv)
+#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 071b2fa..58a6334 100644
--- a/t/op/eval.t
+++ b/t/op/eval.t
@@ -6,7 +6,7 @@ BEGIN {
require './test.pl';
}
-print "1..99\n";
+print "1..103\n";
eval 'print "ok 1\n";';
@@ -557,3 +557,31 @@ $test++;
print "ok $test - RT 63110\n";
$test++;
}
+
+curr_test($test);
+
+fresh_perl_is(<<'EOP', "ok\n", undef, 'RT #70862');
+$::{'@'}='';
+eval {};
+print "ok\n";
+EOP
+
+fresh_perl_is(<<'EOP', "ok\n", undef, 'variant of RT #70862');
+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
--
Perl5 Master Repository