I made a quick fix but it still fails on blead with failing tests.
#undef ERRSV
#define ERRSV *((GvSVn(PL_errgv)),&GvSV(PL_errgv))
with no other changes to the body .xs file.
So those test failures that are still failing aren't related to the GV refactoring right?
C:\sources\Variable-Magic>nmake test
Microsoft (R) Program Maintenance Utility Version 7.10.3077
Copyright (C) Microsoft Corporation. All rights reserved.
"C:\perl521\bin\perl.exe" "-MExtUtils::Command::MM" "-MTest::Harness" "-
e" "undef *Test::Harness::Switches; test_harness(0, 'blib\lib', 'blib\arch')" t\
*.t
t\00-load.t ............... 1/1 # Testing Variable::Magic 0.55, Perl 5.021008 (n
o patchlevel), C:\perl521\bin\perl.exe
t\00-load.t ............... ok
t\01-import.t ............. ok
t\02-constants.t .......... ok
t\10-simple.t ............. ok
t\11-multiple.t ........... ok
t\13-data.t ............... ok
t\14-callbacks.t .......... ok
t\15-self.t ............... ok
t\16-huf.t ................ # Using Hash::Util::FieldHash 1.15
t\16-huf.t ................ ok
t\17-ctl.t ................ ok
t\18-opinfo.t ............. 1/125
# Failed test 'get magic with op_info == 2 doesn't croak'
# at t\18-opinfo.t line 86.
# got: 'Can't coerce GLOB to integer in transliteration (tr///) at (eva
l 138) line 1.
# '
# expected: ''
# { my $c = ""; cast $c, $wiz; $c =~ y/x/y/ }
# Looks like you failed 1 test of 125.
t\18-opinfo.t ............. Dubious, test returned 1 (wstat 256, 0x100)
Failed 1/125 subtests
t\20-get.t ................ ok
t\21-set.t ................ ok
t\22-len.t ................ ok
t\23-clear.t .............. ok
t\24-free.t ............... ok
t\25-copy.t ............... 1/48 # Using Tie::Array 1.06
# Using Tie::Hash 1.05
t\25-copy.t ............... ok
t\27-local.t .............. ok
t\28-uvar.t ............... 1/75 # Using Tie::Hash 1.05
t\28-uvar.t ............... ok
t\30-scalar.t ............. 1/76 # Using Tie::Array 1.06
t\30-scalar.t ............. ok
t\31-array.t .............. ok
t\32-hash.t ............... ok
t\33-code.t ............... ok
t\34-glob.t ............... # Using Symbol 1.07
t\34-glob.t ............... ok
t\35-stash.t .............. ok
t\40-threads.t ............ # Using threads 1.96001
# Using threads::shared 1.47
t\40-threads.t ............ ok
t\41-clone.t .............. # Using threads 1.96001
# Using threads::shared 1.47
t\41-clone.t .............. ok
t\80-leaks.t .............. ok
t\91-pod.t ................ # Using Test::Pod 1.48
t\91-pod.t ................ ok
t\92-pod-coverage.t ....... # Using Test::Pod::Coverage 1.10
# Using Pod::Coverage 0.23
t\92-pod-coverage.t ....... ok
t\93-pod-spelling.t ....... skipped: Could not load Test::Pod::Spelling::CommonM
istakes 1.0
t\95-portability-files.t .. skipped: Could not load Test::Portability::Files
Test Summary Report
-------------------
t\18-opinfo.t (Wstat: 256 Tests: 125 Failed: 1)
Failed test: 98
Non-zero exit status: 1
Files=32, Tests=1473, 7 wallclock secs ( 0.30 usr + 0.06 sys = 0.36 CPU)
Result: FAIL
Failed 1/32 test programs. 1/1473 subtests failed.
NMAKE : fatal error U1077: '"C:\perl521\bin\perl.exe"' : return code '0xff'
Stop.
C:\sources\Variable-Magic>
Full patch of mine attached.
From 203a38df645e527f2b324225df45bd7830960531 Mon Sep 17 00:00:00 2001
From: bulk88 <bulk88@hotmail.com>
Date: Sun, 11 Jan 2015 05:25:15 -0500
Subject: [PATCH] fixes for ERRSV not being an lvalue anymore in 5.21.8
---
Magic.xs | 41 ++++++++++++++++++++++++++---------------
1 files changed, 26 insertions(+), 15 deletions(-)
diff --git a/Magic.xs b/Magic.xs
index 9a07ac5..2decd0c 100644
--- a/Magic.xs
+++ b/Magic.xs
@@ -283,10 +283,11 @@ STATIC I32 vmg_call_sv(pTHX_ SV *sv, I32 flags, int (*cleanup)(pTHX_ void *), vo
I32 ret, cxix;
PERL_CONTEXT saved_cx;
SV *old_err = NULL;
+ SV ** errsvp = (GvSVn(PL_errgv),&GvSV(PL_errgv));
- if (SvTRUE(ERRSV)) {
- old_err = ERRSV;
- ERRSV = newSV(0);
+ if (SvTRUE(*errsvp)) {
+ old_err = *errsvp;
+ *errsvp = newSV(0);
}
cxix = (cxstack_ix < cxstack_max) ? (cxstack_ix + 1) : Perl_cxinc(aTHX);
@@ -298,19 +299,19 @@ STATIC I32 vmg_call_sv(pTHX_ SV *sv, I32 flags, int (*cleanup)(pTHX_ void *), vo
cxstack[cxix] = saved_cx;
- if (SvTRUE(ERRSV)) {
+ if (SvTRUE(*errsvp)) {
if (old_err) {
- sv_setsv(old_err, ERRSV);
- SvREFCNT_dec(ERRSV);
- ERRSV = old_err;
+ sv_setsv(old_err, *errsvp);
+ SvREFCNT_dec(*errsvp);
+ *errsvp = old_err;
}
if (IN_PERL_COMPILETIME) {
if (!PL_in_eval) {
if (PL_errors)
- sv_catsv(PL_errors, ERRSV);
+ sv_catsv(PL_errors, *errsvp);
else
- Perl_warn(aTHX_ "%s", SvPV_nolen(ERRSV));
- SvCUR_set(ERRSV, 0);
+ Perl_warn(aTHX_ "%s", SvPV_nolen(*errsvp));
+ SvCUR_set(*errsvp, 0);
}
#if VMG_HAS_PERL(5, 10, 0) || defined(PL_parser)
if (PL_parser)
@@ -326,8 +327,8 @@ STATIC I32 vmg_call_sv(pTHX_ SV *sv, I32 flags, int (*cleanup)(pTHX_ void *), vo
}
} else {
if (old_err) {
- SvREFCNT_dec(ERRSV);
- ERRSV = old_err;
+ SvREFCNT_dec(*errsvp);
+ *errsvp = old_err;
}
}
@@ -1378,8 +1379,9 @@ STATIC OP *vmg_pp_propagate_errsv(pTHX) {
SVOP *o = cSVOPx(PL_op);
if (o->op_sv) {
- SvREFCNT_dec(ERRSV);
- ERRSV = o->op_sv;
+ SV ** svp = &GvSV(PL_errgv);
+ SvREFCNT_dec(*svp);
+ *svp = o->op_sv;
o->op_sv = NULL;
}
@@ -1390,9 +1392,18 @@ STATIC OP *vmg_pp_propagate_errsv(pTHX) {
STATIC int vmg_propagate_errsv_free(pTHX_ SV *sv, MAGIC *mg) {
if (mg->mg_obj) {
- ERRSV = mg->mg_obj;
+ SV ** svp = &GvSV(PL_errgv);
+ SV * old_sv = *svp;
+ *svp = mg->mg_obj;
mg->mg_obj = NULL;
mg->mg_flags &= ~MGf_REFCOUNTED;
+ /* without this check, a double free will happen and we will reenter
+ vmg_propagate_errsv_free again. It is questionable behaviour why the SV was
+ stored in both the GP SV slot and in mg_obj, with MGf_REFCOUNTED on, yet
+ with a missing recount so without a check a SEGV would occur due to double
+ freeing ~bulk88 jan 11 2015*/
+ if(old_sv != sv)
+ SvREFCNT_dec(old_sv);
}
return 0;
--
1.7.9.msysgit.0
