SvPVX_const() - Patch #1

--GvXjxJ+pjyke8COw
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline

OK, here we go.  After rethinking my methodology for these patches, here
is the first patch to convert SvPVX() to SvPVX_const().  This patch 
includes changes to doio.c, toke.c, universal.c, util.c, and warnings.pl.  
Before checking in this patch, a regen will need to be performed to 
update warnings.h.

These changes have been smoked with a variety of combinations including 
ithreads and DEBUGGING.

Steve Peters
[email protected]

--GvXjxJ+pjyke8COw
Content-Type: text/plain; charset=us-ascii
Content-Disposition: attachment; filename="svpvx_const1.diff"

--- doio.c.old	Wed May 11 03:24:13 2005
+++ doio.c	Fri May 13 14:05:39 2005
@@ -822,7 +822,7 @@
 			sv_catpv(sv,PL_inplace);
 		    }
 #ifndef FLEXFILENAMES
-		    if ((PerlLIO_stat(SvPVX(sv),&PL_statbuf) >= 0
+		    if ((PerlLIO_stat(SvPVX_const(sv),&PL_statbuf) >= 0
 			 && PL_statbuf.st_dev == filedev
 			 && PL_statbuf.st_ino == fileino)
 #ifdef DJGPP
@@ -840,7 +840,7 @@
 #endif
 #ifdef HAS_RENAME
 #if !defined(DOSISH) && !defined(__CYGWIN__) && !defined(EPOC)
-		    if (PerlLIO_rename(PL_oldname,SvPVX(sv)) < 0) {
+		    if (PerlLIO_rename(PL_oldname,SvPVX_const(sv)) < 0) {
 		        if (ckWARN_d(WARN_INPLACE))	
 			    Perl_warner(aTHX_ packWARN(WARN_INPLACE),
 			      "Can't rename %s to %"SVf": %s, skipping file",
@@ -850,13 +850,13 @@
 		    }
 #else
 		    do_close(gv,FALSE);
-		    (void)PerlLIO_unlink(SvPVX(sv));
-		    (void)PerlLIO_rename(PL_oldname,SvPVX(sv));
+		    (void)PerlLIO_unlink(SvPVX_const(sv));
+		    (void)PerlLIO_rename(PL_oldname,SvPVX_const(sv));
 		    do_open(gv,SvPVX(sv),SvCUR(sv),PL_inplace!=0,O_RDONLY,0,Nullfp);
 #endif /* DOSISH */
 #else
-		    (void)UNLINK(SvPVX(sv));
-		    if (link(PL_oldname,SvPVX(sv)) < 0) {
+		    (void)UNLINK(SvPVX_const(sv));
+		    if (link(PL_oldname,SvPVX_const(sv)) < 0) {
 		        if (ckWARN_d(WARN_INPLACE))	
 			    Perl_warner(aTHX_ packWARN(WARN_INPLACE),
 			      "Can't rename %s to %"SVf": %s, skipping file",
@@ -1407,7 +1407,7 @@
 	s = SvPV(sv, len);
 	PL_statgv = Nullgv;
 	sv_setpvn(PL_statname, s, len);
-	s = SvPVX(PL_statname);		/* s now NUL-terminated */
+	s = SvPVX_const(PL_statname);		/* s now NUL-terminated */
 	PL_laststype = OP_STAT;
 	PL_laststatval = PerlLIO_stat(s, &PL_statcache);
 	if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(s, '\n'))
@@ -2356,9 +2356,9 @@
 	}
        if ((tmpfp = PerlIO_tmpfile()) != NULL) {
 	    Stat_t st;
-	    if (!PerlLIO_stat(SvPVX(tmpglob),&st) && S_ISDIR(st.st_mode))
-		ok = ((wilddsc.dsc$a_pointer = tovmspath(SvPVX(tmpglob),vmsspec)) != NULL);
-	    else ok = ((wilddsc.dsc$a_pointer = tovmsspec(SvPVX(tmpglob),vmsspec)) != NULL);
+	    if (!PerlLIO_stat(SvPVX_const(tmpglob),&st) && S_ISDIR(st.st_mode))
+		ok = ((wilddsc.dsc$a_pointer = tovmspath(SvPVX_const(tmpglob),vmsspec)) != NULL);
+	    else ok = ((wilddsc.dsc$a_pointer = tovmsspec(SvPVX_const(tmpglob),vmsspec)) != NULL);
 	    if (ok) wilddsc.dsc$w_length = (unsigned short int) strlen(wilddsc.dsc$a_pointer);
 	    for (cp=wilddsc.dsc$a_pointer; ok && cp && *cp; cp++)
 		if (*cp == '?') *cp = '%';  /* VMS style single-char wildcard */
--- toke.c.old	Thu May 12 05:26:08 2005
+++ toke.c	Mon May 16 15:25:58 2005
@@ -496,7 +496,7 @@
 static void
 strip_return(SV *sv)
 {
-    register const char *s = SvPVX(sv);
+    register const char *s = SvPVX_const(sv);
     register const char *e = s + SvCUR(sv);
     /* outer loop optimized to do nothing if there are no CR-LFs */
     while (s < e) {
@@ -1069,7 +1069,7 @@
 	goto finish;
     d = s;
     if ( PL_hints & HINT_NEW_STRING ) {
-	pv = sv_2mortal(newSVpvn(SvPVX(pv), len));
+	pv = sv_2mortal(newSVpvn(SvPVX_const(pv), len));
 	if (SvUTF8(sv))
 	    SvUTF8_on(pv);
     }
@@ -1081,7 +1081,7 @@
 	*d++ = *s++;
     }
     *d = '\0';
-    SvCUR_set(sv, d - SvPVX(sv));
+    SvCUR_set(sv, d - SvPVX_const(sv));
   finish:
     if ( PL_hints & HINT_NEW_STRING )
        return new_constant(NULL, 0, "q", sv, pv, "q");
@@ -1407,7 +1407,7 @@
 		    continue;
 		}
 
-		i = d - SvPVX(sv);		/* remember current offset */
+		i = d - SvPVX_const(sv);		/* remember current offset */
 		SvGROW(sv, SvLEN(sv) + 256);	/* never more than 256 chars in a range */
 		d = SvPVX(sv) + i;		/* refresh d after realloc */
 		d -= 2;				/* eat the first char and the - */
@@ -1634,7 +1634,7 @@
 			    }
 			}
 			if (hicount) {
-			    STRLEN offset = d - SvPVX(sv);
+			    STRLEN offset = d - SvPVX_const(sv);
 			    U8 *src, *dst;
 			    d = SvGROW(sv, SvLEN(sv) + hicount + 1) + offset;
 			    src = (U8 *)d - 1;
@@ -1724,7 +1724,7 @@
 		    }
 #endif
 		    if (!has_utf8 && SvUTF8(res)) {
-			char *ostart = SvPVX(sv);
+			const char *ostart = SvPVX_const(sv);
 			SvCUR_set(sv, d - ostart);
 			SvPOK_on(sv);
 			*d = '\0';
@@ -1735,7 +1735,7 @@
 			has_utf8 = TRUE;
 		    }
 		    if (len > (STRLEN)(e - s + 4)) { /* I _guess_ 4 is \N{} --jhi */
-			char *odest = SvPVX(sv);
+			const char *odest = SvPVX_const(sv);
 
 			SvGROW(sv, (SvLEN(sv) + len - (e - s + 4)));
 			d = SvPVX(sv) + (d - odest);
@@ -1804,7 +1804,7 @@
 	    s += len;
 	    if (need > len) {
 		/* encoded value larger than old, need extra space (NOTE: SvCUR() not set here) */
-		STRLEN off = d - SvPVX(sv);
+		STRLEN off = d - SvPVX_const(sv);
 		d = SvGROW(sv, SvLEN(sv) + (need-len)) + off;
 	    }
 	    d = (char*)uvchr_to_utf8((U8*)d, uv);
@@ -1817,7 +1817,7 @@
 
     /* terminate the string and set up the sv */
     *d = '\0';
-    SvCUR_set(sv, d - SvPVX(sv));
+    SvCUR_set(sv, d - SvPVX_const(sv));
     if (SvCUR(sv) >= SvLEN(sv))
 	Perl_croak(aTHX_ "panic: constant overflowed allocated space");
 
@@ -2044,7 +2044,7 @@
 	if (GvIO(gv))
 	    return 0;
 	if ((cv = GvCVu(gv))) {
-	    const char *proto = SvPVX(cv);
+	    const char *proto = SvPVX_const(cv);
 	    if (proto) {
 		if (*proto == ';')
 		    proto++;
@@ -4173,7 +4173,7 @@
 		yylval.opval->op_private = OPpCONST_BARE;
 		/* UTF-8 package name? */
 		if (UTF && !IN_BYTES &&
-		    is_utf8_string((U8*)SvPVX(sv), SvCUR(sv)))
+		    is_utf8_string((U8*)SvPVX_const(sv), SvCUR(sv)))
 		    SvUTF8_on(sv);
 
 		/* And if "Foo::", then that's what it certainly is. */
@@ -8985,7 +8985,7 @@
 	msg = Perl_newSVpvf(aTHX_ "Constant(%s): %s%s%s",
 			    (type ? type: "undef"), why1, why2, why3);
     msgdone:
-	yyerror(SvPVX(msg));
+	yyerror(SvPVX_const(msg));
  	SvREFCNT_dec(msg);
   	return sv;
     }
@@ -9495,7 +9495,7 @@
 	}
 	*d = '\0';
 	PL_bufend = d;
-	SvCUR_set(PL_linestr, PL_bufend - SvPVX(PL_linestr));
+	SvCUR_set(PL_linestr, PL_bufend - SvPVX_const(PL_linestr));
 	s = olds;
     }
 #endif
@@ -9544,7 +9544,7 @@
 	sv_setpvn(tmpstr,d+1,s-d);
 	s += len - 1;
 	sv_catpvn(herewas,s,bufend-s);
-	Copy(SvPVX(herewas),bufptr,SvCUR(herewas) + 1,char);
+	Copy(SvPVX_const(herewas),bufptr,SvCUR(herewas) + 1,char);
 
 	s = olds;
 	goto retval;
@@ -9588,7 +9588,7 @@
 	    {
 		PL_bufend[-2] = '\n';
 		PL_bufend--;
-		SvCUR_set(PL_linestr, PL_bufend - SvPVX(PL_linestr));
+		SvCUR_set(PL_linestr, PL_bufend - SvPVX_const(PL_linestr));
 	    }
 	    else if (PL_bufend[-1] == '\r')
 		PL_bufend[-1] = '\n';
@@ -9606,7 +9606,7 @@
 	    av_store(CopFILEAV(PL_curcop), (I32)CopLINE(PL_curcop),sv);
 	}
 	if (*s == term && memEQ(s,PL_tokenbuf,len)) {
-	    STRLEN off = PL_bufend - 1 - SvPVX(PL_linestr);
+	    STRLEN off = PL_bufend - 1 - SvPVX_const(PL_linestr);
 	    *(SvPVX(PL_linestr) + off ) = ' ';
 	    sv_catsv(PL_linestr,herewas);
 	    PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
@@ -9625,7 +9625,7 @@
     }
     SvREFCNT_dec(herewas);
     if (!IN_BYTES) {
-	if (UTF && is_utf8_string((U8*)SvPVX(tmpstr), SvCUR(tmpstr)))
+	if (UTF && is_utf8_string((U8*)SvPVX_const(tmpstr), SvCUR(tmpstr)))
 	    SvUTF8_on(tmpstr);
 	else if (PL_encoding)
 	    sv_recode_to_utf8(tmpstr, PL_encoding);
@@ -9899,10 +9899,10 @@
 	    bool cont = TRUE;
 
 	    while (cont) {
-		int offset = s - SvPVX(PL_linestr);
+		int offset = s - SvPVX_const(PL_linestr);
 		bool found = sv_cat_decode(sv, PL_encoding, PL_linestr,
 					   &offset, (char*)termstr, termlen);
-		char *ns = SvPVX(PL_linestr) + offset;
+		const char *ns = SvPVX_const(PL_linestr) + offset;
 		char *svlast = SvEND(sv) - 1;
 
 		for (; s < ns; s++) {
@@ -9915,7 +9915,7 @@
 		    /* handle quoted delimiters */
 		    if (SvCUR(sv) > 1 && *(svlast-1) == '\\') {
 			const char *t;
-			for (t = svlast-2; t >= SvPVX(sv) && *t == '\\';)
+			for (t = svlast-2; t >= SvPVX_const(sv) && *t == '\\';)
 			    t--;
 			if ((svlast-1 - t) % 2) {
 			    if (!keep_quoted) {
@@ -9951,7 +9951,7 @@
 			if (w < t) {
 			    *w++ = term;
 			    *w = '\0';
-			    SvCUR_set(sv, w - SvPVX(sv));
+			    SvCUR_set(sv, w - SvPVX_const(sv));
 			}
 			last = w;
 			if (--brackets <= 0)
@@ -10029,7 +10029,7 @@
 	}
 	/* terminate the copied string and update the sv's end-of-string */
 	*to = '\0';
-	SvCUR_set(sv, to - SvPVX(sv));
+	SvCUR_set(sv, to - SvPVX_const(sv));
 
 	/*
 	 * this next chunk reads more into the buffer if we're not done yet
@@ -10039,18 +10039,18 @@
 	    break;		/* handle case where we are done yet :-) */
 
 #ifndef PERL_STRICT_CR
-	if (to - SvPVX(sv) >= 2) {
+	if (to - SvPVX_const(sv) >= 2) {
 	    if ((to[-2] == '\r' && to[-1] == '\n') ||
 		(to[-2] == '\n' && to[-1] == '\r'))
 	    {
 		to[-2] = '\n';
 		to--;
-		SvCUR_set(sv, to - SvPVX(sv));
+		SvCUR_set(sv, to - SvPVX_const(sv));
 	    }
 	    else if (to[-1] == '\r')
 		to[-1] = '\n';
 	}
-	else if (to - SvPVX(sv) == 1 && to[-1] == '\r')
+	else if (to - SvPVX_const(sv) == 1 && to[-1] == '\r')
 	    to[-1] = '\n';
 #endif
 	
@@ -10567,7 +10567,7 @@
 	    else
 	      break;
 	}
-	s = eol;
+	s = (char*)eol;
 	if (PL_rsfp) {
 	    s = filter_gets(PL_linestr, PL_rsfp, 0);
 	    PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = SvPVX(PL_linestr);
@@ -10591,7 +10591,7 @@
 	else
 	    PL_lex_state = LEX_FORMLINE;
 	if (!IN_BYTES) {
-	    if (UTF && is_utf8_string((U8*)SvPVX(stuff), SvCUR(stuff)))
+	    if (UTF && is_utf8_string((U8*)SvPVX_const(stuff), SvCUR(stuff)))
 		SvUTF8_on(stuff);
 	    else if (PL_encoding)
 		sv_recode_to_utf8(stuff, PL_encoding);
@@ -10717,7 +10717,7 @@
 	    Perl_sv_catpvf(aTHX_ where_sv, "%c", yychar);
 	else
 	    Perl_sv_catpvf(aTHX_ where_sv, "\\%03o", yychar & 255);
-	where = SvPVX(where_sv);
+	where = SvPVX_const(where_sv);
     }
     msg = sv_2mortal(newSVpv(s, 0));
     Perl_sv_catpvf(aTHX_ msg, " at %s line %"IVdf", ",
@@ -10876,8 +10876,8 @@
 	U8* tmps;
 	I32 newlen;
 	New(898, tmps, SvCUR(sv) * 3 / 2 + 1, U8);
-	Copy(SvPVX(sv), tmps, old, char);
-	utf16_to_utf8((U8*)SvPVX(sv) + old, tmps + old,
+	Copy(SvPVX_const(sv), tmps, old, char);
+	utf16_to_utf8((U8*)SvPVX_const(sv) + old, tmps + old,
 		      SvCUR(sv) - old, &newlen);
 	sv_usepvn(sv, (char*)tmps, (STRLEN)newlen + old);
     }
@@ -10897,8 +10897,8 @@
 	U8* tmps;
 	I32 newlen;
 	New(898, tmps, SvCUR(sv) * 3 / 2 + 1, U8);
-	Copy(SvPVX(sv), tmps, old, char);
-	utf16_to_utf8((U8*)SvPVX(sv) + old, tmps + old,
+	Copy(SvPVX_const(sv), tmps, old, char);
+	utf16_to_utf8((U8*)SvPVX_const(sv) + old, tmps + old,
 		      SvCUR(sv) - old, &newlen);
 	sv_usepvn(sv, (char*)tmps, (STRLEN)newlen + old);
     }
--- universal.c.old	Wed May 11 03:24:14 2005
+++ universal.c	Mon May 16 10:48:00 2005
@@ -881,9 +881,9 @@
 
 		  if (details) {
 		       XPUSHs(namok ?
-			     newSVpv(SvPVX(*namsvp), 0) : &PL_sv_undef);
+			     newSVpv(SvPVX_const(*namsvp), 0) : &PL_sv_undef);
 		       XPUSHs(argok ?
-			     newSVpv(SvPVX(*argsvp), 0) : &PL_sv_undef);
+			     newSVpv(SvPVX_const(*argsvp), 0) : &PL_sv_undef);
 		       if (flgok)
 			    XPUSHi(SvIVX(*flgsvp));
 		       else
--- util.c.old	Wed May 11 03:24:14 2005
+++ util.c	Fri May 13 13:10:13 2005
@@ -1008,7 +1008,7 @@
 	    OutCopFILE(cop), (IV)CopLINE(cop));
 	if (GvIO(PL_last_in_gv) && IoLINES(GvIOp(PL_last_in_gv))) {
 	    const bool line_mode = (RsSIMPLE(PL_rs) &&
-			      SvCUR(PL_rs) == 1 && *SvPVX(PL_rs) == '\n');
+			      SvCUR(PL_rs) == 1 && *SvPVX_const(PL_rs) == '\n');
 	    Perl_sv_catpvf(aTHX_ sv, ", <%s> %s %"IVdf,
 			   PL_last_in_gv == PL_argvgv ?
 			   "" : GvNAME(PL_last_in_gv),
@@ -2732,13 +2732,13 @@
 	sv_setpv(tmpsv, ".");
     else
 	sv_setpvn(tmpsv, a, fa - a);
-    if (PerlLIO_stat(SvPVX(tmpsv), &tmpstatbuf1) < 0)
+    if (PerlLIO_stat(SvPVX_const(tmpsv), &tmpstatbuf1) < 0)
 	return FALSE;
     if (fb == b)
 	sv_setpv(tmpsv, ".");
     else
 	sv_setpvn(tmpsv, b, fb - b);
-    if (PerlLIO_stat(SvPVX(tmpsv), &tmpstatbuf2) < 0)
+    if (PerlLIO_stat(SvPVX_const(tmpsv), &tmpstatbuf2) < 0)
 	return FALSE;
     return tmpstatbuf1.st_dev == tmpstatbuf2.st_dev &&
 	   tmpstatbuf1.st_ino == tmpstatbuf2.st_ino;
@@ -3765,7 +3765,7 @@
 
 	if (pathlen) {
 	    /* shift down */
-	    Move(SvPVX(sv), SvPVX(sv) + namelen + 1, pathlen, char);
+	    Move(SvPVX_const(sv), SvPVX(sv) + namelen + 1, pathlen, char);
 	}
 
 	/* prepend current directory to the front */
@@ -3787,7 +3787,7 @@
 	*SvEND(sv) = '\0';
 	SvPOK_only(sv);
 
-	if (PerlDir_chdir(SvPVX(sv)) < 0) {
+	if (PerlDir_chdir(SvPVX_const(sv)) < 0) {
 	    SV_CWD_RETURN_UNDEF;
 	}
     }
--- warnings.pl.old	Wed May 11 03:24:14 2005
+++ warnings.pl	Mon May 16 10:42:00 2005
@@ -325,8 +325,8 @@
 #define isLEXWARN_on 	(PL_curcop->cop_warnings != pWARN_STD)
 #define isLEXWARN_off	(PL_curcop->cop_warnings == pWARN_STD)
 #define isWARN_ONCE	(PL_dowarn & (G_WARN_ON|G_WARN_ONCE))
-#define isWARN_on(c,x)	(IsSet(SvPVX(c), 2*(x)))
-#define isWARNf_on(c,x)	(IsSet(SvPVX(c), 2*(x)+1))
+#define isWARN_on(c,x)	(IsSet(SvPVX_const(c), 2*(x)))
+#define isWARNf_on(c,x)	(IsSet(SvPVX_const(c), 2*(x)+1))
 
 #define ckWARN(x)							\
 	( (isLEXWARN_on && PL_curcop->cop_warnings != pWARN_NONE &&	\

--GvXjxJ+pjyke8COw--