From: Nicholas Clark <nick@ccl4.org>
Date: Tue, 7 Jun 2005 18:38:39 +0000 (+0000)
Subject: More SvPV consting.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e62f0680cdecd36f79df8a7dabc61c6a2739f07a;p=p5sagit%2Fp5-mst-13.2.git

More SvPV consting.

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

diff --git a/doio.c b/doio.c
index 7457c90..79ca1fd 100644
--- a/doio.c
+++ b/doio.c
@@ -1176,7 +1176,7 @@ Perl_mode_from_discipline(pTHX_ SV *discp)
     int mode = O_BINARY;
     if (discp) {
 	STRLEN len;
-	const char *s = SvPV(discp,len);
+	const char *s = SvPV_const(discp,len);
 	while (*s) {
 	    if (*s == ':') {
 		switch (s[1]) {
@@ -1423,7 +1423,6 @@ Perl_my_lstat(pTHX)
 {
     dSP;
     SV *sv;
-    STRLEN n_a;
     if (PL_op->op_flags & OPf_REF) {
 	EXTEND(SP,1);
 	if (cGVOP_gv == PL_defgv) {
@@ -1451,9 +1450,9 @@ Perl_my_lstat(pTHX)
 	return (PL_laststatval = -1);
     }
     /* XXX Do really need to be calling SvPV() all these times? */
-    sv_setpv(PL_statname,SvPV(sv, n_a));
-    PL_laststatval = PerlLIO_lstat(SvPV(sv, n_a),&PL_statcache);
-    if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, n_a), '\n'))
+    sv_setpv(PL_statname,SvPV_nolen_const(sv));
+    PL_laststatval = PerlLIO_lstat(SvPV_nolen_const(sv),&PL_statcache);
+    if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(SvPV_nolen_const(sv), '\n'))
 	Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "lstat");
     return PL_laststatval;
 }
@@ -1476,20 +1475,19 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp,
 #else
     register char **a;
     const char *tmps = Nullch;
-    STRLEN n_a;
 
     if (sp > mark) {
 	New(401,PL_Argv, sp - mark + 1, char*);
 	a = PL_Argv;
 	while (++mark <= sp) {
 	    if (*mark)
-		*a++ = SvPVx(*mark, n_a);
+		*a++ = (char*)SvPV_nolen_const(*mark);
 	    else
 		*a++ = "";
 	}
 	*a = Nullch;
 	if (really)
-	    tmps = SvPV(really, n_a);
+	    tmps = SvPV_nolen_const(really);
 	if ((!really && *PL_Argv[0] != '/') ||
 	    (really && *tmps != '/'))		/* will execvp use PATH? */
 	    TAINT_ENV();		/* testing IFS here is overkill, probably */
@@ -1674,7 +1672,6 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
     const char *what;
     const char *s;
     SV **oldmark = mark;
-    STRLEN n_a;
 
 #define APPLY_TAINT_PROPER() \
     STMT_START {							\
@@ -1700,7 +1697,7 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
 	    APPLY_TAINT_PROPER();
 	    tot = sp - mark;
 	    while (++mark <= sp) {
-		const char *name = SvPVx(*mark, n_a);
+		const char *name = SvPV_nolen_const(*mark);
 		APPLY_TAINT_PROPER();
 		if (PerlLIO_chmod(name, val))
 		    tot--;
@@ -1718,7 +1715,7 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
 	    APPLY_TAINT_PROPER();
 	    tot = sp - mark;
 	    while (++mark <= sp) {
-		const char *name = SvPVx(*mark, n_a);
+		const char *name = SvPV_nolen_const(*mark);
 		APPLY_TAINT_PROPER();
 		if (PerlLIO_chown(name, val, val2))
 		    tot--;
@@ -1738,7 +1735,7 @@ nothing in the core.
 	APPLY_TAINT_PROPER();
 	if (mark == sp)
 	    break;
-	s = SvPVx_const(*++mark, n_a);
+	s = SvPVx_nolen_const(*++mark);
 	if (isALPHA(*s)) {
 	    if (*s == 'S' && s[1] == 'I' && s[2] == 'G')
 		s += 3;
@@ -1808,7 +1805,7 @@ nothing in the core.
 	APPLY_TAINT_PROPER();
 	tot = sp - mark;
 	while (++mark <= sp) {
-	    s = SvPVx_const(*mark, n_a);
+	    s = SvPV_nolen_const(*mark);
 	    APPLY_TAINT_PROPER();
 	    if (PL_euid || PL_unsafe) {
 		if (UNLINK(s))
@@ -1862,8 +1859,7 @@ nothing in the core.
 	    APPLY_TAINT_PROPER();
 	    tot = sp - mark;
 	    while (++mark <= sp) {
-		STRLEN n_a;
-		const char *name = SvPVx(*mark, n_a);
+		const char *name = SvPV_nolen_const(*mark);
 		APPLY_TAINT_PROPER();
 		if (PerlLIO_utime(name, utbufp))
 		    tot--;
diff --git a/doop.c b/doop.c
index adf36ea..d7ab071 100644
--- a/doop.c
+++ b/doop.c
@@ -1149,12 +1149,12 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
     register char *dc;
     STRLEN leftlen;
     STRLEN rightlen;
-    register char *lc;
-    register char *rc;
+    register const char *lc;
+    register const char *rc;
     register I32 len;
     I32 lensave;
-    char *lsave;
-    char *rsave;
+    const char *lsave;
+    const char *rsave;
     const bool left_utf = DO_UTF8(left);
     const bool right_utf = DO_UTF8(right);
     I32 needlen = 0;
@@ -1166,8 +1166,8 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
 
     if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv)))
 	sv_setpvn(sv, "", 0);	/* avoid undef warning on |= and ^= */
-    lsave = lc = SvPV_nomg(left, leftlen);
-    rsave = rc = SvPV_nomg(right, rightlen);
+    lsave = lc = SvPV_nomg_const(left, leftlen);
+    rsave = rc = SvPV_nomg_const(right, rightlen);
     len = leftlen < rightlen ? leftlen : rightlen;
     lensave = len;
     if ((left_utf || right_utf) && (sv == left || sv == right)) {
diff --git a/gv.c b/gv.c
index f757f4c..68dbd72 100644
--- a/gv.c
+++ b/gv.c
@@ -498,7 +498,7 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
 	return Nullgv;
     if (stash) {
 	if (SvTYPE(stash) < SVt_PVHV) {
-	    packname = SvPV((SV*)stash, packname_len);
+	    packname = SvPV_const((SV*)stash, packname_len);
 	    stash = Nullhv;
 	}
 	else {
@@ -1865,7 +1865,7 @@ bool
 Perl_is_gv_magical_sv(pTHX_ SV *name, U32 flags)
 {
     STRLEN len;
-    const char *temp = SvPV(name, len);
+    const char *temp = SvPV_const(name, len);
     return is_gv_magical(temp, len, flags);
 }
 
diff --git a/mg.c b/mg.c
index e7f3b21..e161847 100644
--- a/mg.c
+++ b/mg.c
@@ -953,11 +953,11 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR;
     register char *s;
-    char *ptr;
+    const char *ptr;
     STRLEN len, klen;
 
     s = SvPV(sv,len);
-    ptr = MgPV(mg,klen);
+    ptr = MgPV_const(mg,klen);
     my_setenv(ptr, s);
 
 #ifdef DYNAMIC_ENV_FETCH
diff --git a/perlio.c b/perlio.c
index 05963d0..55148e8 100644
--- a/perlio.c
+++ b/perlio.c
@@ -308,7 +308,7 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
 	if (*args == &PL_sv_undef)
 	    return PerlIO_tmpfile();
 	else {
-	    const char *name = SvPV_nolen(*args);
+	    const char *name = SvPV_nolen_const(*args);
 	    if (*mode == IoTYPE_NUMERIC) {
 		fd = PerlLIO_open3(name, imode, perm);
 		if (fd >= 0)
@@ -334,7 +334,7 @@ XS(XS_PerlIO__Layer__find)
     if (items < 2)
 	Perl_croak(aTHX_ "Usage class->find(name[,load])");
     else {
-	const char *name = SvPV_nolen(ST(1));
+	const char *name = SvPV_nolen_const(ST(1));
 	ST(0) = (strEQ(name, "crlf")
 		 || strEQ(name, "raw")) ? &PL_sv_yes : &PL_sv_undef;
 	XSRETURN(1);
@@ -844,7 +844,7 @@ XS(XS_io_MODIFY_SCALAR_ATTRIBUTES)
     Perl_warn(aTHX_ "attrib %" SVf, sv);
     for (i = 2; i < items; i++) {
 	STRLEN len;
-	const char *name = SvPV(ST(i), len);
+	const char *name = SvPV_const(ST(i), len);
 	SV *layer = PerlIO_find_layer(aTHX_ name, len, 1);
 	if (layer) {
 	    av_push(av, SvREFCNT_inc(layer));
@@ -875,7 +875,7 @@ XS(XS_PerlIO__Layer__NoWarnings)
      */
     dXSARGS;
     if (items)
-    	PerlIO_debug("warning:%s\n",SvPV_nolen(ST(0)));
+    	PerlIO_debug("warning:%s\n",SvPV_nolen_const(ST(0)));
     XSRETURN(0);
 }
 
@@ -886,7 +886,7 @@ XS(XS_PerlIO__Layer__find)
 	Perl_croak(aTHX_ "Usage class->find(name[,load])");
     else {
 	STRLEN len;
-	const char *name = SvPV(ST(1), len);
+	const char *name = SvPV_const(ST(1), len);
 	const bool load = (items > 2) ? SvTRUE(ST(2)) : 0;
 	PerlIO_funcs *layer = PerlIO_find_layer(aTHX_ name, len, load);
 	ST(0) =
@@ -2443,7 +2443,7 @@ PerlIOUnix_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 	    perm = 0666;
 	}
 	if (imode != -1) {
-	    const char *path = SvPV_nolen(*args);
+	    const char *path = SvPV_nolen_const(*args);
 	    fd = PerlLIO_open3(path, imode, perm);
 	}
     }
@@ -2732,7 +2732,7 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 {
     char tmode[8];
     if (PerlIOValid(f)) {
-	const char *path = SvPV_nolen(*args);
+	const char *path = SvPV_nolen_const(*args);
 	PerlIOStdio *s = PerlIOSelf(f, PerlIOStdio);
 	FILE *stdio;
 	PerlIOUnix_refcnt_dec(fileno(s->stdio));
@@ -2746,7 +2746,7 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
     }
     else {
 	if (narg > 0) {
-	    const char *path = SvPV_nolen(*args);
+	    const char *path = SvPV_nolen_const(*args);
 	    if (*mode == IoTYPE_NUMERIC) {
 		mode++;
 		fd = PerlLIO_open3(path, imode, perm);
diff --git a/pp.c b/pp.c
index 896b573..3299076 100644
--- a/pp.c
+++ b/pp.c
@@ -553,10 +553,9 @@ PP(pp_gelem)
     SV *tmpRef;
     const char *elem;
     dSP;
-    STRLEN n_a;
 
     sv = POPs;
-    elem = SvPV(sv, n_a);
+    elem = SvPV_nolen_const(sv);
     gv = (GV*)POPs;
     tmpRef = Nullsv;
     sv = Nullsv;
diff --git a/pp_ctl.c b/pp_ctl.c
index afc7dea..befebb6 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -78,9 +78,7 @@ PP(pp_regcomp)
 {
     dSP;
     register PMOP *pm = (PMOP*)cLOGOP->op_other;
-    register char *t;
     SV *tmpstr;
-    STRLEN len;
     MAGIC *mg = Null(MAGIC*);
 
     /* prevent recompiling under /o and ithreads. */
@@ -129,7 +127,8 @@ PP(pp_regcomp)
 	PM_SETRE(pm, ReREFCNT_inc(re));
     }
     else {
-	t = SvPV(tmpstr, len);
+	STRLEN len;
+	const char *t = SvPV_const(tmpstr, len);
 
 	/* Check against the last compiled regexp. */
 	if (!PM_GETRE(pm) || !PM_GETRE(pm)->precomp ||
@@ -151,7 +150,7 @@ PP(pp_regcomp)
 		if (pm->op_pmdynflags & PMdf_UTF8)
 		    t = (char*)bytes_to_utf8((U8*)t, &len);
 	    }
-	    PM_SETRE(pm, CALLREGCOMP(aTHX_ t, t + len, pm));
+	    PM_SETRE(pm, CALLREGCOMP(aTHX_ (char *)t, (char *)t + len, pm));
 	    if (!DO_UTF8(tmpstr) && (pm->op_pmdynflags & PMdf_UTF8))
 		Safefree(t);
 	    PL_reginterp_cnt = 0;	/* XXXX Be extra paranoid - needed
@@ -1710,7 +1709,7 @@ PP(pp_reset)
     if (MAXARG < 1)
 	tmps = "";
     else
-	tmps = POPpx;
+	tmps = POPpconstx;
     sv_reset(tmps, CopSTASH(PL_curcop));
     PUSHs(&PL_sv_yes);
     RETURN;
diff --git a/pp_hot.c b/pp_hot.c
index 6925862..5115e03 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1719,7 +1719,7 @@ PP(pp_helem)
 	    else {
 		if (!preeminent) {
 		    STRLEN keylen;
-		    const char * const key = SvPV(keysv, keylen);
+		    const char * const key = SvPV_const(keysv, keylen);
 		    SAVEDELETE(hv, savepvn(key,keylen), keylen);
 		} else
 		    save_helem(hv, keysv, svp);
diff --git a/pp_pack.c b/pp_pack.c
index 6d57ddc..b3c2f07 100644
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -2750,7 +2750,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    const char *aptr;
 
 	    fromstr = NEXTFROM;
-	    aptr = SvPV(fromstr, fromlen);
+	    aptr = SvPV_const(fromstr, fromlen);
 	    if (DO_UTF8(fromstr)) {
                 const char *end, *s;
 
diff --git a/pp_sys.c b/pp_sys.c
index bce7ffe..0a25560 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -335,7 +335,7 @@ PP(pp_backtick)
     if (fp) {
         const char *type = NULL;
 	if (PL_curcop->cop_io) {
-	    type = SvPV_nolen(PL_curcop->cop_io);
+	    type = SvPV_nolen_const(PL_curcop->cop_io);
 	}
 	if (type && *type)
 	    PerlIO_apply_layers(aTHX_ fp,mode,type);
@@ -446,14 +446,14 @@ PP(pp_warn)
     else {
 	tmpsv = TOPs;
     }
-    tmps = SvPV(tmpsv, len);
+    tmps = SvPV_const(tmpsv, len);
     if ((!tmps || !len) && PL_errgv) {
   	SV *error = ERRSV;
 	SvUPGRADE(error, SVt_PV);
 	if (SvPOK(error) && SvCUR(error))
 	    sv_catpv(error, "\t...caught");
 	tmpsv = error;
-	tmps = SvPV(tmpsv, len);
+	tmps = SvPV_const(tmpsv, len);
     }
     if (!tmps || !len)
 	tmpsv = sv_2mortal(newSVpvn("Warning: something's wrong", 26));
@@ -513,7 +513,7 @@ PP(pp_die)
 	    if (SvPOK(error) && SvCUR(error))
 		sv_catpv(error, "\t...propagated");
 	    tmpsv = error;
-	    tmps = SvPV(tmpsv, len);
+	    tmps = SvPV_const(tmpsv, len);
 	}
     }
     if (!tmps || !len)
@@ -766,11 +766,11 @@ PP(pp_binmode)
 
     PUTBACK;
     if (PerlIO_binmode(aTHX_ fp,IoTYPE(io),mode_from_discipline(discp),
-                       (discp) ? SvPV_nolen(discp) : Nullch)) {
+                       (discp) ? SvPV_nolen_const(discp) : Nullch)) {
 	if (IoOFP(io) && IoOFP(io) != IoIFP(io)) {
 	     if (!PerlIO_binmode(aTHX_ IoOFP(io),IoTYPE(io),
 			mode_from_discipline(discp),
-                       (discp) ? SvPV_nolen(discp) : Nullch)) {
+                       (discp) ? SvPV_nolen_const(discp) : Nullch)) {
 		SPAGAIN;
 		RETPUSHUNDEF;
 	     }
@@ -1301,9 +1301,9 @@ PP(pp_enterwrite)
     if (!cv) {
 	if (fgv) {
 	    SV * const tmpsv = sv_newmortal();
-	    char *name;
+	    const char *name;
 	    gv_efullname4(tmpsv, fgv, Nullch, FALSE);
-	    name = SvPV_nolen(tmpsv);
+	    name = SvPV_nolen_const(tmpsv);
 	    if (name && *name)
 		DIE(aTHX_ "Undefined format \"%s\" called", name);
 	}
@@ -1392,7 +1392,7 @@ PP(pp_leavewrite)
 	    SV * const sv = sv_newmortal();
 	    const char *name;
 	    gv_efullname4(sv, fgv, Nullch, FALSE);
-	    name = SvPV_nolen(sv);
+	    name = SvPV_nolen_const(sv);
 	    if (name && *name)
 		DIE(aTHX_ "Undefined top format \"%s\" called",name);
 	}
@@ -1521,7 +1521,7 @@ PP(pp_sysopen)
     dSP;
     GV *gv;
     SV *sv;
-    char *tmps;
+    const char *tmps;
     STRLEN len;
     const int perm = (MAXARG > 3) ? POPi : 0666;
     const int mode = POPi;
@@ -1531,8 +1531,9 @@ PP(pp_sysopen)
 
     /* Need TIEHANDLE method ? */
 
-    tmps = SvPV(sv, len);
-    if (do_open(gv, tmps, len, TRUE, mode, perm, Nullfp)) {
+    tmps = SvPV_const(sv, len);
+    /* FIXME? do_open should do const  */
+    if (do_open(gv, (char*)tmps, len, TRUE, mode, perm, Nullfp)) {
 	IoLINES(GvIOp(gv)) = 0;
 	PUSHs(&PL_sv_yes);
     }
@@ -3647,9 +3648,8 @@ PP(pp_rename)
     dSP; dTARGET;
     int anum;
     STRLEN n_a;
-
-    char *tmps2 = POPpx;
-    char *tmps = SvPV(TOPs, n_a);
+    const char *tmps2 = POPpconstx;
+    const char *tmps = SvPV_nolen_const(TOPs);
     TAINT_PROPER("rename");
 #ifdef HAS_RENAME
     anum = PerlLIO_rename(tmps, tmps2);
@@ -3674,8 +3674,8 @@ PP(pp_link)
 #ifdef HAS_LINK
     dSP; dTARGET;
     STRLEN n_a;
-    char *tmps2 = POPpx;
-    char *tmps = SvPV(TOPs, n_a);
+    const char *tmps2 = POPpconstx;
+    const char *tmps = SvPV_nolen_const(TOPs);
     TAINT_PROPER("link");
     SETi( PerlLIO_link(tmps, tmps2) >= 0 );
     RETURN;
diff --git a/sv.c b/sv.c
index 3f2f953..e9fe2c9 100644
--- a/sv.c
+++ b/sv.c
@@ -2248,8 +2248,9 @@ S_not_a_number(pTHX_ SV *sv)
 	  /* each *s can expand to 4 chars + "...\0",
 	     i.e. need room for 8 chars */
 	
-	  char *s, *end;
-	  for (s = SvPVX(sv), end = s + SvCUR(sv); s < end && d < limit; s++) {
+	  const char *s, *end;
+	  for (s = SvPVX_const(sv), end = s + SvCUR(sv); s < end && d < limit;
+	       s++) {
 	       int ch = *s & 0xFF;
 	       if (ch & 128 && !isPRINT_LC(ch)) {
 		    *d++ = 'M';
@@ -6191,7 +6192,7 @@ Perl_sv_len_utf8(pTHX_ register SV *sv)
     else
     {
 	STRLEN len, ulen;
-	const U8 *s = (U8*)SvPV(sv, len);
+	const U8 *s = (U8*)SvPV_const(sv, len);
 	MAGIC *mg = SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_utf8) : 0;
 
 	if (mg && mg->mg_len != -1 && (mg->mg_len > 0 || len == 0)) {
diff --git a/toke.c b/toke.c
index f0c1f04..ddaa0aa 100644
--- a/toke.c
+++ b/toke.c
@@ -980,7 +980,7 @@ Perl_str_to_version(pTHX_ SV *sv)
     NV retval = 0.0;
     NV nshift = 1.0;
     STRLEN len;
-    const char *start = SvPVx(sv,len);
+    const char *start = SvPVx_const(sv,len);
     const char *end = start + len;
     const bool utf = SvUTF8(sv) ? TRUE : FALSE;
     while (start < end) {
diff --git a/universal.c b/universal.c
index 6c118b7..eb4f531 100644
--- a/universal.c
+++ b/universal.c
@@ -268,7 +268,7 @@ XS(XS_UNIVERSAL_isa)
 		|| (SvGMAGICAL(sv) && SvPOKp(sv) && SvCUR(sv))))
 	XSRETURN_UNDEF;
 
-    name = (const char *)SvPV(ST(1),n_a);
+    name = SvPV_const(ST(1),n_a);
 
     ST(0) = boolSV(sv_derived_from(sv, name));
     XSRETURN(1);
@@ -295,7 +295,7 @@ XS(XS_UNIVERSAL_can)
 		|| (SvGMAGICAL(sv) && SvPOKp(sv) && SvCUR(sv))))
 	XSRETURN_UNDEF;
 
-    name = (const char *)SvPV(ST(1),n_a);
+    name = SvPV_const(ST(1),n_a);
     rv = &PL_sv_undef;
 
     if (SvROK(sv)) {
@@ -642,7 +642,7 @@ XS(XS_utf8_valid)
 	  SV *	sv = ST(0);
 	  {
 	       STRLEN len;
-	       const char *s = SvPV(sv,len);
+	       const char *s = SvPV_const(sv,len);
 	       if (!SvUTF8(sv) || is_utf8_string((const U8*)s,len))
 		    XSRETURN_YES;
 	       else
@@ -810,7 +810,7 @@ XS(XS_PerlIO_get_layers)
 		  SV **varp = svp;
 		  SV **valp = svp + 1;
 		  STRLEN klen;
-                  const char *key = SvPV(*varp, klen);
+                  const char *key = SvPV_const(*varp, klen);
 
 		  switch (*key) {
 		  case 'i':
diff --git a/util.c b/util.c
index cd9ab4c..ae831e4 100644
--- a/util.c
+++ b/util.c
@@ -839,7 +839,7 @@ char *
 Perl_savesvpv(pTHX_ SV *sv)
 {
     STRLEN len;
-    const char *pv = SvPV(sv, len);
+    const char *pv = SvPV_const(sv, len);
     register char *newaddr;
 
     ++len;