More SvPV consting, including some code cleanup and living dangerously

with socket API calls.

p4raw-id: //depot/perl@24799

6 files changed, 47 insertions, 43 deletions

diff --git a/pp.c b/pp.c
index 0e528cdf07..ae75edfb31 100644
--- a/pp.c
+++ b/pp.c
@@ -2912,7 +2912,7 @@ PP(pp_hex)
     UV result_uv;
     SV* sv = POPs;
 
-    tmps = (SvPVx_const(sv, len));
+    tmps = (SvPV_const(sv, len));
     if (DO_UTF8(sv)) {
 	 /* If Unicode, try to downgrade
 	  * If not possible, croak. */
@@ -2920,7 +2920,7 @@ PP(pp_hex)
 	
 	 SvUTF8_on(tsv);
 	 sv_utf8_downgrade(tsv, FALSE);
-	 tmps = SvPVX(tsv);
+	 tmps = SvPV_const(tsv, len);
     }
     result_uv = grok_hex (tmps, &len, &flags, &result_nv);
     if (flags & PERL_SCAN_GREATER_THAN_UV_MAX) {
@@ -2942,7 +2942,7 @@ PP(pp_oct)
     UV result_uv;
     SV* sv = POPs;
 
-    tmps = (SvPVx_const(sv, len));
+    tmps = (SvPV_const(sv, len));
     if (DO_UTF8(sv)) {
 	 /* If Unicode, try to downgrade
 	  * If not possible, croak. */
@@ -2950,7 +2950,7 @@ PP(pp_oct)
 	
 	 SvUTF8_on(tsv);
 	 sv_utf8_downgrade(tsv, FALSE);
-	 tmps = SvPVX(tsv);
+	 tmps = SvPV_const(tsv, len);
     }
     while (*tmps && len && isSPACE(*tmps))
         tmps++, len--;
@@ -3109,7 +3109,7 @@ PP(pp_substr)
 	    if (repl_need_utf8_upgrade) {
 		repl_sv_copy = newSVsv(repl_sv);
 		sv_utf8_upgrade(repl_sv_copy);
-		repl = SvPV(repl_sv_copy, repl_len);
+		repl = SvPV_const(repl_sv_copy, repl_len);
 		repl_is_utf8 = DO_UTF8(repl_sv_copy) && SvCUR(sv);
 	    }
 	    sv_insert(sv, pos, rem, repl, repl_len);
@@ -3334,7 +3334,7 @@ PP(pp_ord)
     dSP; dTARGET;
     SV *argsv = POPs;
     STRLEN len;
-    const U8 *s = (U8*)SvPVx_const(argsv, len);
+    const U8 *s = (U8*)SvPV_const(argsv, len);
     SV *tmpsv;
 
     if (PL_encoding && SvPOK(argsv) && !DO_UTF8(argsv)) {
@@ -3374,7 +3374,7 @@ PP(pp_chr)
     if (value > 255 && !IN_BYTES) {
 	SvGROW(TARG, (STRLEN)UNISKIP(value)+1);
 	tmps = (char*)uvchr_to_utf8_flags((U8*)SvPVX(TARG), value, 0);
-	SvCUR_set(TARG, tmps - SvPVX(TARG));
+	SvCUR_set(TARG, tmps - SvPVX_const(TARG));
 	*tmps = '\0';
 	(void)SvPOK_only(TARG);
 	SvUTF8_on(TARG);
@@ -3422,7 +3422,7 @@ PP(pp_crypt)
 
 	 SvUTF8_on(tsv);
 	 sv_utf8_downgrade(tsv, FALSE);
-	 tmps = SvPVX(tsv);
+	 tmps = SvPV_const(tsv, len);
     }
 #   ifdef USE_ITHREADS
 #     ifdef HAS_CRYPT_R
@@ -3611,7 +3611,7 @@ PP(pp_uc)
 		if (ulen > u && (SvLEN(TARG) < (min += ulen - u))) {
 		    /* If the eventually required minimum size outgrows
 		     * the available space, we need to grow. */
-		    UV o = d - (U8*)SvPVX(TARG);
+		    UV o = d - (U8*)SvPVX_const(TARG);
 
 		    /* If someone uppercases one million U+03B0s we
 		     * SvGROW() one million times.  Or we could try
@@ -3626,7 +3626,7 @@ PP(pp_uc)
 	    }
 	    *d = '\0';
 	    SvUTF8_on(TARG);
-	    SvCUR_set(TARG, d - (U8*)SvPVX(TARG));
+	    SvCUR_set(TARG, d - (U8*)SvPVX_const(TARG));
 	    SETs(TARG);
 	}
     }
@@ -3714,7 +3714,7 @@ PP(pp_lc)
 		if (ulen > u && (SvLEN(TARG) < (min += ulen - u))) {
 		    /* If the eventually required minimum size outgrows
 		     * the available space, we need to grow. */
-		    UV o = d - (U8*)SvPVX(TARG);
+		    UV o = d - (U8*)SvPVX_const(TARG);
 
 		    /* If someone lowercases one million U+0130s we
 		     * SvGROW() one million times.  Or we could try
@@ -3729,7 +3729,7 @@ PP(pp_lc)
 	    }
 	    *d = '\0';
 	    SvUTF8_on(TARG);
-	    SvCUR_set(TARG, d - (U8*)SvPVX(TARG));
+	    SvCUR_set(TARG, d - (U8*)SvPVX_const(TARG));
 	    SETs(TARG);
 	}
     }
@@ -3803,7 +3803,7 @@ PP(pp_quotemeta)
 	    }
 	}
 	*d = '\0';
-	SvCUR_set(TARG, d - SvPVX(TARG));
+	SvCUR_set(TARG, d - SvPVX_const(TARG));
 	(void)SvPOK_only_UTF8(TARG);
     }
     else
@@ -4485,7 +4485,7 @@ PP(pp_reverse)
 	if (len > 1) {
 	    if (DO_UTF8(TARG)) {	/* first reverse each character */
 		U8* s = (U8*)SvPVX(TARG);
-		U8* send = (U8*)(s + len);
+		const U8* send = (U8*)(s + len);
 		while (s < send) {
 		    if (UTF8_IS_INVARIANT(*s)) {
 			s++;
diff --git a/pp_ctl.c b/pp_ctl.c
index 032d716b9f..8355b58b8c 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1148,7 +1148,7 @@ PP(pp_flop)
 	else {
 	    SV *final = sv_mortalcopy(right);
 	    STRLEN len;
-	    const char *tmps = SvPV(final, len);
+	    const char *tmps = SvPV_const(final, len);
 
 	    sv = sv_mortalcopy(left);
 	    SvPV_force_nolen(sv);
@@ -1409,7 +1409,7 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen)
 		    sv_setpvn(err,"",0);
 		else if (SvCUR(err) >= sizeof(prefix)+msglen-1) {
 		    STRLEN len;
-		    e = SvPV(err, len);
+		    e = SvPV_const(err, len);
 		    e += len - msglen;
 		    if (*e != *message || strNE(e,message))
 			e = Nullch;
@@ -1446,7 +1446,7 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen)
 	    POPBLOCK(cx,PL_curpm);
 	    if (CxTYPE(cx) != CXt_EVAL) {
 		if (!message)
-		    message = SvPVx(ERRSV, msglen);
+		    message = SvPVx_const(ERRSV, msglen);
 		PerlIO_write(Perl_error_log, "panic: die ", 11);
 		PerlIO_write(Perl_error_log, message, msglen);
 		my_exit(1);
@@ -1478,7 +1478,7 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen)
 	}
     }
     if (!message)
-	message = SvPVx(ERRSV, msglen);
+	message = SvPVx_const(ERRSV, msglen);
 
     write_to_stderr(message, msglen);
     my_failure_exit();
@@ -3027,7 +3027,7 @@ S_doopen_pm(pTHX_ const char *name, const char *mode)
 
     if (namelen > 3 && strEQ(name + namelen - 3, ".pm")) {
 	SV *pmcsv = Perl_newSVpvf(aTHX_ "%s%c", name, 'c');
-	const char * const pmc = SvPV_nolen(pmcsv);
+	const char * const pmc = SvPV_nolen_const(pmcsv);
 	Stat_t pmstat;
 	Stat_t pmcstat;
 	if (PerlLIO_stat(pmc, &pmcstat) < 0) {
@@ -3142,7 +3142,7 @@ PP(pp_require)
 
 		    Perl_sv_setpvf(aTHX_ namesv, "/loader/0x%"UVxf"/%s",
 				   PTR2UV(SvRV(dirsv)), name);
-		    tryname = SvPVX(namesv);
+		    tryname = SvPVX_const(namesv);
 		    tryrsfp = 0;
 
 		    ENTER;
@@ -3283,7 +3283,7 @@ PP(pp_require)
 #  endif
 #endif
 		    TAINT_PROPER("require");
-		    tryname = SvPVX(namesv);
+		    tryname = SvPVX_const(namesv);
 		    tryrsfp = doopen_pm(tryname, PERL_SCRIPT_MODE);
 		    if (tryrsfp) {
 			if (tryname[0] == '.' && tryname[1] == '/')
@@ -3319,7 +3319,7 @@ PP(pp_require)
 		}
 		sv_catpvn(msg, ")", 1);
 		SvREFCNT_dec(dirmsgsv);
-		msgstr = SvPV_nolen(msg);
+		msgstr = SvPV_nolen_const(msg);
 	    }
 	    DIE(aTHX_ "Can't locate %s", msgstr);
 	}
diff --git a/pp_hot.c b/pp_hot.c
index 508840393b..04becac90f 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -153,7 +153,7 @@ PP(pp_concat)
 
     if (TARG == right && right != left) {
 	right = sv_2mortal(newSVpvn(rpv, rlen));
-	rpv = SvPV(right, rlen);	/* no point setting UTF-8 here */
+	rpv = SvPV_const(right, rlen);	/* no point setting UTF-8 here */
 	rcopied = TRUE;
     }
 
@@ -186,7 +186,7 @@ PP(pp_concat)
 	    if (!rcopied)
 		right = sv_2mortal(newSVpvn(rpv, rlen));
 	    sv_utf8_upgrade_nomg(right);
-	    rpv = SvPV(right, rlen);
+	    rpv = SvPV_const(right, rlen);
 	}
     }
     sv_catpvn_nomg(TARG, rpv, rlen);
@@ -1590,6 +1590,7 @@ Perl_do_readline(pTHX)
 	XPUSHs(sv);
 	if (type == OP_GLOB) {
 	    char *tmps;
+	    const char *t1;
 
 	    if (SvCUR(sv) > 0 && SvCUR(PL_rs) > 0) {
 		tmps = SvEND(sv) - 1;
@@ -1598,16 +1599,16 @@ Perl_do_readline(pTHX)
 		    SvCUR_set(sv, SvCUR(sv) - 1);
 		}
 	    }
-	    for (tmps = SvPVX(sv); *tmps; tmps++)
-		if (!isALPHA(*tmps) && !isDIGIT(*tmps) &&
-		    strchr("$&*(){}[]'\";\\|?<>~`", *tmps))
+	    for (t1 = SvPVX_const(sv); *t1; t1++)
+		if (!isALPHA(*t1) && !isDIGIT(*t1) &&
+		    strchr("$&*(){}[]'\";\\|?<>~`", *t1))
 			break;
-	    if (*tmps && PerlLIO_lstat(SvPVX_const(sv), &PL_statbuf) < 0) {
+	    if (*t1 && PerlLIO_lstat(SvPVX_const(sv), &PL_statbuf) < 0) {
 		(void)POPs;		/* Unmatched wildcard?  Chuck it... */
 		continue;
 	    }
 	} else if (SvUTF8(sv)) { /* OP_READLINE, OP_RCATLINE */
-	     const U8 *s = (U8*)SvPVX(sv) + offset;
+	     const U8 *s = (const U8*)SvPVX_const(sv) + offset;
 	     const STRLEN len = SvCUR(sv) - offset;
 	     const U8 *f;
 	     
diff --git a/pp_pack.c b/pp_pack.c
index 16e724e452..dbd26d9068 100644
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -3388,7 +3388,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 
 		  w_string:
 		    /* Copy string and check for compliance */
-		    from = SvPV(fromstr, len);
+		    from = SvPV_const(fromstr, len);
 		    if ((norm = is_an_int(from, len)) == NULL)
 			Perl_croak(aTHX_ "Can only compress unsigned integers in pack");
 
@@ -3601,7 +3601,8 @@ PP(pp_pack)
     dSP; dMARK; dORIGMARK; dTARGET;
     register SV *cat = TARG;
     STRLEN fromlen;
-    register const char *pat = SvPVx_const(*++MARK, fromlen);
+    SV *pat_sv = *++MARK;
+    register const char *pat = SvPV_const(pat_sv, fromlen);
     register const char *patend = pat + fromlen;
 
     MARK++;
diff --git a/pp_sort.c b/pp_sort.c
index 03ab0e5afc..b1c62267aa 100644
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1526,7 +1526,7 @@ PP(pp_sort)
 	else {
 	    cv = sv_2cv(*++MARK, &stash, &gv, 0);
 	    if (cv && SvPOK(cv)) {
-		char *proto = SvPV_nolen((SV*)cv);
+		const char *proto = SvPV_nolen_const((SV*)cv);
 		if (proto && strEQ(proto, "$$")) {
 		    hasargs = TRUE;
 		}
diff --git a/pp_sys.c b/pp_sys.c
index 1444a0f862..4e2b412968 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -2437,7 +2437,8 @@ PP(pp_bind)
     extern void GETUSERMODE();
 #endif
     SV *addrsv = POPs;
-    char *addr;
+    /* OK, so on what platform does bind modify addr?  */
+    const char *addr;
     GV *gv = (GV*)POPs;
     register IO *io = GvIOn(gv);
     STRLEN len;
@@ -2449,7 +2450,7 @@ PP(pp_bind)
     if (!io || !IoIFP(io))
 	goto nuts;
 
-    addr = SvPV(addrsv, len);
+    addr = SvPV_const(addrsv, len);
     TAINT_PROPER("bind");
 #ifdef MPE /* Deal with MPE bind() peculiarities */
     if (((struct sockaddr *)addr)->sa_family == AF_INET) {
@@ -2492,7 +2493,7 @@ PP(pp_connect)
 #ifdef HAS_SOCKET
     dSP;
     SV *addrsv = POPs;
-    char *addr;
+    const char *addr;
     GV *gv = (GV*)POPs;
     register IO *io = GvIOn(gv);
     STRLEN len;
@@ -2500,7 +2501,7 @@ PP(pp_connect)
     if (!io || !IoIFP(io))
 	goto nuts;
 
-    addr = SvPV(addrsv, len);
+    addr = SvPV_const(addrsv, len);
     TAINT_PROPER("connect");
     if (PerlSock_connect(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
 	RETPUSHYES;
@@ -2687,16 +2688,16 @@ PP(pp_ssockopt)
 	PUSHs(sv);
 	break;
     case OP_SSOCKOPT: {
-	    char *buf;
+	    const char *buf;
 	    int aint;
 	    if (SvPOKp(sv)) {
 		STRLEN l;
-		buf = SvPV(sv, l);
+		buf = SvPV_const(sv, l);
 		len = l;
 	    }
 	    else {
 		aint = (int)SvIV(sv);
-		buf = (char*)&aint;
+		buf = (const char*)&aint;
 		len = sizeof(int);
 	    }
 	    if (PerlSock_setsockopt(fd, lvl, optname, buf, len) < 0)
@@ -2760,8 +2761,8 @@ PP(pp_getpeername)
 	{
 	    static const char nowhere[] = "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0";
 	    /* If the call succeeded, make sure we don't have a zeroed port/addr */
-	    if (((struct sockaddr *)SvPVX(sv))->sa_family == AF_INET &&
-		!memcmp((char *)SvPVX(sv) + sizeof(u_short), nowhere,
+	    if (((struct sockaddr *)SvPVX_const(sv))->sa_family == AF_INET &&
+		!memcmp((char *)SvPVX_const(sv) + sizeof(u_short), nowhere,
 			sizeof(u_short) + sizeof(struct in_addr))) {
 		goto nuts2;	
 	    }
@@ -3356,7 +3357,7 @@ PP(pp_fttty)
     if (GvIO(gv) && IoIFP(GvIOp(gv)))
 	fd = PerlIO_fileno(IoIFP(GvIOp(gv)));
     else if (tmpsv && SvOK(tmpsv)) {
-	char *tmps = SvPV_nolen(tmpsv);
+	const char *tmps = SvPV_nolen_const(tmpsv);
 	if (isDIGIT(*tmps))
 	    fd = atoi(tmps);
 	else 
@@ -3458,7 +3459,8 @@ PP(pp_fttext)
 	PL_laststype = OP_STAT;
 	sv_setpv(PL_statname, SvPV_nolen_const(sv));
 	if (!(fp = PerlIO_open(SvPVX_const(PL_statname), "r"))) {
-	    if (ckWARN(WARN_NEWLINE) && strchr(SvPV_nolen(PL_statname), '\n'))
+	    if (ckWARN(WARN_NEWLINE) && strchr(SvPV_nolen_const(PL_statname),
+					       '\n'))
 		Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open");
 	    RETPUSHUNDEF;
 	}