From: Marcus Holland-Moritz <mhx-perl@gmx.net>
Date: Fri, 7 Nov 2008 22:33:39 +0000 (+0000)
Subject: Revert SvPVX() to allow lvalue usage, but also add a
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d2c6dc5ee586de7e57a1fe8c160cf7c8aaf3f3f8;p=p5sagit%2Fp5-mst-13.2.git

Revert SvPVX() to allow lvalue usage, but also add a
MUTABLE_SV() check. Use SvPVX_const() instead of SvPVX()
where only a const SV* is available. Also fix two falsely
consted pointers in Perl_sv_2pv_flags().

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

diff --git a/op.c b/op.c
index 5e3dd3c..1200422 100644
--- a/op.c
+++ b/op.c
@@ -7919,7 +7919,7 @@ Perl_ck_join(pTHX_ OP *o)
     if (kid && kid->op_type == OP_MATCH) {
 	if (ckWARN(WARN_SYNTAX)) {
             const REGEXP *re = PM_GETRE(kPMOP);
-	    const char *pmstr = re ? RX_PRECOMP(re) : "STRING";
+	    const char *pmstr = re ? RX_PRECOMP_const(re) : "STRING";
 	    const STRLEN len = re ? RX_PRELEN(re) : 6;
 	    Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
 			"/%.*s/ should probably be written as \"%.*s\"",
diff --git a/regexec.c b/regexec.c
index 363e205..025d159 100644
--- a/regexec.c
+++ b/regexec.c
@@ -2590,7 +2590,7 @@ S_debug_start_match(pTHX_ const REGEXP *prog, const bool do_utf8,
             reginitcolors();    
     {
         RE_PV_QUOTED_DECL(s0, utf8_pat, PERL_DEBUG_PAD_ZERO(0), 
-            RX_PRECOMP(prog), RX_PRELEN(prog), 60);   
+            RX_PRECOMP_const(prog), RX_PRELEN(prog), 60);   
         
         RE_PV_QUOTED_DECL(s1, do_utf8, PERL_DEBUG_PAD_ZERO(1), 
             start, end - start, 60); 
diff --git a/regexp.h b/regexp.h
index 8cce3b3..e8a8cc0 100644
--- a/regexp.h
+++ b/regexp.h
@@ -371,11 +371,13 @@ and check for NULL.
 
 /* For source compatibility. We used to store these explicitly.  */
 #define RX_PRECOMP(prog)	(RX_WRAPPED(prog) + ((struct regexp *)SvANY(prog))->pre_prefix)
+#define RX_PRECOMP_const(prog)	(RX_WRAPPED_const(prog) + ((struct regexp *)SvANY(prog))->pre_prefix)
 /* FIXME? Are we hardcoding too much here and constraining plugin extension
    writers? Specifically, the value 1 assumes that the wrapped version always
    has exactly one character at the end, a ')'. Will that always be true?  */
 #define RX_PRELEN(prog)		(RX_WRAPLEN(prog) - ((struct regexp *)SvANY(prog))->pre_prefix - 1)
 #define RX_WRAPPED(prog)	SvPVX(prog)
+#define RX_WRAPPED_const(prog)	SvPVX_const(prog)
 #define RX_WRAPLEN(prog)	SvCUR(prog)
 #define RX_CHECK_SUBSTR(prog)	(((struct regexp *)SvANY(prog))->check_substr)
 #define RX_REFCNT(prog)		SvREFCNT(prog)
diff --git a/sv.c b/sv.c
index e9a384b..65b6249 100644
--- a/sv.c
+++ b/sv.c
@@ -2840,13 +2840,13 @@ Perl_sv_2pv_flags(pTHX_ register SV *const sv, STRLEN *const lp, const I32 flags
 		STRLEN len;
 		char *retval;
 		char *buffer;
-		const SV *const referent = SvRV(sv);
+		SV *const referent = SvRV(sv);
 
 		if (!referent) {
 		    len = 7;
 		    retval = buffer = savepvn("NULLREF", len);
 		} else if (SvTYPE(referent) == SVt_REGEXP) {
-		    const REGEXP * const re = (REGEXP *)referent;
+		    REGEXP * const re = (REGEXP *)MUTABLE_PTR(referent);
 		    I32 seen_evals = 0;
 
 		    assert(re);
@@ -10567,7 +10567,7 @@ Perl_rvpv_dup(pTHX_ SV *const dstr, const SV *const sstr, CLONE_PARAMS *const pa
 	    }
 	    else {
 		/* Some other special case - random pointer */
-		SvPV_set(dstr, SvPVX(sstr));		
+		SvPV_set(dstr, (char *) SvPVX_const(sstr));		
 	    }
 	}
     }
diff --git a/sv.h b/sv.h
index 2722083..3717070 100644
--- a/sv.h
+++ b/sv.h
@@ -1072,7 +1072,7 @@ the scalar's value cannot change unless written to.
 #  if defined (DEBUGGING) && defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
 /* These get expanded inside other macros that already use a variable _sv  */
 #    define SvPVX(sv)							\
-	(*({ const SV *const _svpvx = (const SV *)(sv);			\
+	(*({ SV *const _svpvx = MUTABLE_SV(sv);				\
 	    assert(SvTYPE(_svpvx) >= SVt_PV);				\
 	    assert(SvTYPE(_svpvx) != SVt_PVAV);				\
 	    assert(SvTYPE(_svpvx) != SVt_PVHV);				\