warnings and const violations identified by compiling in C++ mode

with GCC v2.95

p4raw-id: //depot/perl@4461

12 files changed, 38 insertions, 35 deletions

diff --git a/doio.c b/doio.c
index bf961f0c07..123815d2f4 100644
--- a/doio.c
+++ b/doio.c
@@ -168,7 +168,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 	if (fd == -1)
 	    fp = NULL;
 	else {
-	    char *fpmode;
+	    const char *fpmode;
 	    if (result == O_RDONLY)
 		fpmode = "r";
 #ifdef O_APPEND
diff --git a/embed.pl b/embed.pl
index 8f964a294e..93c2e2acca 100755
--- a/embed.pl
+++ b/embed.pl
@@ -1666,7 +1666,7 @@ p	|SV*	|swash_init	|char* pkg|char* name|SV* listsv \
 				|I32 minbits|I32 none
 p	|UV	|swash_fetch	|SV *sv|U8 *ptr
 p	|void	|taint_env
-p	|void	|taint_proper	|const char* f|char* s
+p	|void	|taint_proper	|const char* f|const char* s
 p	|UV	|to_utf8_lower	|U8 *p
 p	|UV	|to_utf8_upper	|U8 *p
 p	|UV	|to_utf8_title	|U8 *p
@@ -2050,8 +2050,8 @@ s	|I32	|sublex_done
 s	|I32	|sublex_push
 s	|I32	|sublex_start
 s	|char *	|filter_gets	|SV *sv|PerlIO *fp|STRLEN append
-s	|SV*	|new_constant	|char *s|STRLEN len|char *key|SV *sv \
-				|SV *pv|char *type
+s	|SV*	|new_constant	|char *s|STRLEN len|const char *key|SV *sv \
+				|SV *pv|const char *type
 s	|int	|ao		|int toketype
 s	|void	|depcom
 s	|char*	|incl_perldb
diff --git a/mg.c b/mg.c
index 09be2f7bdb..3fa094832b 100644
--- a/mg.c
+++ b/mg.c
@@ -1126,7 +1126,7 @@ int
 Perl_magic_nextpack(pTHX_ SV *sv, MAGIC *mg, SV *key)
 {
     dSP;
-    char *meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY";
+    const char *meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY";
 
     ENTER;
     SAVETMPS;
diff --git a/op.c b/op.c
index 7fae9f75ca..d0880214c7 100644
--- a/op.c
+++ b/op.c
@@ -1810,9 +1810,9 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right)
       char *desc = PL_op_desc[(right->op_type == OP_SUBST ||
                             right->op_type == OP_TRANS)
                            ? right->op_type : OP_MATCH];
-      char *sample = ((left->op_type == OP_RV2AV ||
-                       left->op_type == OP_PADAV)
-                      ? "@array" : "%hash");
+      const char *sample = ((left->op_type == OP_RV2AV ||
+			     left->op_type == OP_PADAV)
+			    ? "@array" : "%hash");
       Perl_warner(aTHX_ WARN_UNSAFE,
              "Applying %s to %s will act on scalar(%s)", 
              desc, sample, sample);
diff --git a/perl.c b/perl.c
index 2ed116c716..1e0de5105d 100644
--- a/perl.c
+++ b/perl.c
@@ -1589,7 +1589,7 @@ Perl_moreswitches(pTHX_ char *s)
     case '0':
     {
 	dTHR;
-	rschar = scan_oct(s, 4, &numlen);
+	rschar = (U32)scan_oct(s, 4, &numlen);
 	SvREFCNT_dec(PL_nrs);
 	if (rschar & ~((U8)~0))
 	    PL_nrs = &PL_sv_undef;
@@ -1691,7 +1691,7 @@ Perl_moreswitches(pTHX_ char *s)
 	if (isDIGIT(*s)) {
 	    PL_ors = savepv("\n");
 	    PL_orslen = 1;
-	    *PL_ors = scan_oct(s, 3 + (*s == '0'), &numlen);
+	    *PL_ors = (char)scan_oct(s, 3 + (*s == '0'), &numlen);
 	    s += numlen;
 	}
 	else {
diff --git a/perlapi.c b/perlapi.c
index adfb4afd85..41dd32a387 100644
--- a/perlapi.c
+++ b/perlapi.c
@@ -4203,7 +4203,7 @@ Perl_taint_env(pTHXo)
 
 #undef  Perl_taint_proper
 void
-Perl_taint_proper(pTHXo_ const char* f, char* s)
+Perl_taint_proper(pTHXo_ const char* f, const char* s)
 {
     ((CPerlObj*)pPerl)->Perl_taint_proper(f, s);
 }
diff --git a/proto.h b/proto.h
index 4cb4ba1a36..4393e48364 100644
--- a/proto.h
+++ b/proto.h
@@ -638,7 +638,7 @@ VIRTUAL void	Perl_sv_vsetpvfn(pTHX_ SV* sv, const char* pat, STRLEN patlen, va_l
 VIRTUAL SV*	Perl_swash_init(pTHX_ char* pkg, char* name, SV* listsv, I32 minbits, I32 none);
 VIRTUAL UV	Perl_swash_fetch(pTHX_ SV *sv, U8 *ptr);
 VIRTUAL void	Perl_taint_env(pTHX);
-VIRTUAL void	Perl_taint_proper(pTHX_ const char* f, char* s);
+VIRTUAL void	Perl_taint_proper(pTHX_ const char* f, const char* s);
 VIRTUAL UV	Perl_to_utf8_lower(pTHX_ U8 *p);
 VIRTUAL UV	Perl_to_utf8_upper(pTHX_ U8 *p);
 VIRTUAL UV	Perl_to_utf8_title(pTHX_ U8 *p);
@@ -991,7 +991,7 @@ STATIC I32	S_sublex_done(pTHX);
 STATIC I32	S_sublex_push(pTHX);
 STATIC I32	S_sublex_start(pTHX);
 STATIC char *	S_filter_gets(pTHX_ SV *sv, PerlIO *fp, STRLEN append);
-STATIC SV*	S_new_constant(pTHX_ char *s, STRLEN len, char *key, SV *sv, SV *pv, char *type);
+STATIC SV*	S_new_constant(pTHX_ char *s, STRLEN len, const char *key, SV *sv, SV *pv, const char *type);
 STATIC int	S_ao(pTHX_ int toketype);
 STATIC void	S_depcom(pTHX);
 STATIC char*	S_incl_perldb(pTHX);
diff --git a/regcomp.c b/regcomp.c
index 2a27b07743..b522077e25 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -2022,7 +2022,7 @@ tryagain:
 			    if (!e)
 				FAIL("Missing right brace on \\x{}");
 			    else if (UTF) {
-				ender = scan_hex(p + 1, e - p, &numlen);
+				ender = (UV)scan_hex(p + 1, e - p, &numlen);
 				if (numlen + len >= 127) {	/* numlen is generous */
 				    p--;
 				    goto loopdone;
@@ -2033,7 +2033,7 @@ tryagain:
 				FAIL("Can't use \\x{} without 'use utf8' declaration");
 			}
 			else {
-			    ender = scan_hex(p, 2, &numlen);
+			    ender = (UV)scan_hex(p, 2, &numlen);
 			    p += numlen;
 			}
 			break;
@@ -2046,7 +2046,7 @@ tryagain:
 		    case '5': case '6': case '7': case '8':case '9':
 			if (*p == '0' ||
 			  (isDIGIT(p[1]) && atoi(p) >= PL_regnpar) ) {
-			    ender = scan_oct(p, 3, &numlen);
+			    ender = (UV)scan_oct(p, 3, &numlen);
 			    p += numlen;
 			}
 			else {
@@ -2293,7 +2293,7 @@ S_regclass(pTHX)
 {
     dTHR;
     register char *opnd, *s;
-    register I32 value;
+    register UV value;
     register I32 lastvalue = OOB_CHAR8;
     register I32 range = 0;
     register regnode *ret;
@@ -2352,7 +2352,7 @@ S_regclass(pTHX)
 	    case 'e':	value = '\033';			break;
 	    case 'a':	value = '\007';			break;
 	    case 'x':
-		value = scan_hex(PL_regcomp_parse, 2, &numlen);
+		value = (UV)scan_hex(PL_regcomp_parse, 2, &numlen);
 		PL_regcomp_parse += numlen;
 		break;
 	    case 'c':
@@ -2361,7 +2361,7 @@ S_regclass(pTHX)
 		break;
 	    case '0': case '1': case '2': case '3': case '4':
 	    case '5': case '6': case '7': case '8': case '9':
-		value = scan_oct(--PL_regcomp_parse, 3, &numlen);
+		value = (UV)scan_oct(--PL_regcomp_parse, 3, &numlen);
 		PL_regcomp_parse += numlen;
 		break;
 	    default:
@@ -2712,7 +2712,7 @@ S_regclassutf8(pTHX)
 {
     dTHR;
     register char *opnd, *e;
-    register U32 value;
+    register UV value;
     register U32 lastvalue = OOB_UTF8;
     register I32 range = 0;
     register regnode *ret;
@@ -2796,13 +2796,13 @@ S_regclassutf8(pTHX)
 		    e = strchr(PL_regcomp_parse++, '}');
                     if (!e)
                         FAIL("Missing right brace on \\x{}");
-		    value = scan_hex(PL_regcomp_parse,
+		    value = (UV)scan_hex(PL_regcomp_parse,
 				     e - PL_regcomp_parse,
 				     &numlen);
 		    PL_regcomp_parse = e + 1;
 		}
 		else {
-		    value = scan_hex(PL_regcomp_parse, 2, &numlen);
+		    value = (UV)scan_hex(PL_regcomp_parse, 2, &numlen);
 		    PL_regcomp_parse += numlen;
 		}
 		break;
@@ -2812,7 +2812,7 @@ S_regclassutf8(pTHX)
 		break;
 	    case '0': case '1': case '2': case '3': case '4':
 	    case '5': case '6': case '7': case '8': case '9':
-		value = scan_oct(--PL_regcomp_parse, 3, &numlen);
+		value = (UV)scan_oct(--PL_regcomp_parse, 3, &numlen);
 		PL_regcomp_parse += numlen;
 		break;
 	    default:
diff --git a/sv.c b/sv.c
index 4402b861b2..44eb29f705 100644
--- a/sv.c
+++ b/sv.c
@@ -5348,7 +5348,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	    case 16:
 		if (!uv)
 		    alt = FALSE;
-		p = (c == 'X') ? "0123456789ABCDEF" : "0123456789abcdef";
+		p = (char*)((c == 'X')
+			    ? "0123456789ABCDEF" : "0123456789abcdef");
 		do {
 		    dig = uv & 15;
 		    *--eptr = p[dig];
diff --git a/taint.c b/taint.c
index c272066e8d..c0a71cb2d8 100644
--- a/taint.c
+++ b/taint.c
@@ -9,7 +9,7 @@
 #include "perl.h"
 
 void
-Perl_taint_proper(pTHX_ const char *f, char *s)
+Perl_taint_proper(pTHX_ const char *f, const char *s)
 {
     dTHR;	/* just for taint */
     char *ug;
diff --git a/toke.c b/toke.c
index 8597144b1f..cbac39bace 100644
--- a/toke.c
+++ b/toke.c
@@ -1153,7 +1153,7 @@ S_scan_const(pTHX_ char *start)
 	? (PL_sublex_info.sub_op->op_private & (PL_lex_repl ?
 						OPpTRANS_FROM_UTF : OPpTRANS_TO_UTF))
 	: UTF;
-    char *leaveit =			/* set of acceptably-backslashed characters */
+    const char *leaveit =	/* set of acceptably-backslashed characters */
 	PL_lex_inpat
 	    ? "\\.^$@AGZdDwWsSbBpPXC+*?|()-nrtfeaxcz0123456789[{]} \t\n\r\f\v#"
 	    : "";
@@ -1330,7 +1330,7 @@ S_scan_const(pTHX_ char *start)
 	    /* \132 indicates an octal constant */
 	    case '0': case '1': case '2': case '3':
 	    case '4': case '5': case '6': case '7':
-		*d++ = scan_oct(s, 3, &len);
+		*d++ = (char)scan_oct(s, 3, &len);
 		s += len;
 		continue;
 
@@ -1352,7 +1352,7 @@ S_scan_const(pTHX_ char *start)
 		    }
 		    /* note: utf always shorter than hex */
 		    d = (char*)uv_to_utf8((U8*)d,
-					  scan_hex(s + 1, e - s - 1, &len));
+					  (UV)scan_hex(s + 1, e - s - 1, &len));
 		    s = e + 1;
 		}
 		else {
@@ -5460,14 +5460,15 @@ S_checkcomma(pTHX_ register char *s, char *name, char *what)
    and type is used with error messages only. */
 
 STATIC SV *
-S_new_constant(pTHX_ char *s, STRLEN len, char *key, SV *sv, SV *pv, char *type) 
+S_new_constant(pTHX_ char *s, STRLEN len, const char *key, SV *sv, SV *pv,
+	       const char *type) 
 {
     dSP;
     HV *table = GvHV(PL_hintgv);		 /* ^H */
     SV *res;
     SV **cvp;
     SV *cv, *typesv;
-    char *why, *why1, *why2;
+    const char *why, *why1, *why2;
     
     if (!(PL_hints & HINT_LOCALIZE_HH)) {
 	SV *msg;
@@ -5695,7 +5696,7 @@ S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN des
 	    if ((*s == '[' || (*s == '{' && strNE(dest, "sub")))) {
 		dTHR;			/* only for ckWARN */
 		if (ckWARN(WARN_AMBIGUOUS) && keyword(dest, d - dest)) {
-		    char *brack = *s == '[' ? "[...]" : "{...}";
+		    const char *brack = *s == '[' ? "[...]" : "{...}";
 		    Perl_warner(aTHX_ WARN_AMBIGUOUS,
 			"Ambiguous use of %c{%s%s} resolved to %c%s%s",
 			funny, dest, brack, funny, dest, brack);
diff --git a/win32/win32.c b/win32/win32.c
index 1bfb6feaa0..efb52d92a9 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -94,7 +94,7 @@ int _CRT_glob = 0;
 #endif
 
 static void		get_shell(void);
-static long		tokenize(char *str, char **dest, char ***destv);
+static long		tokenize(const char *str, char **dest, char ***destv);
 	int		do_spawn2(char *cmd, int exectype);
 static BOOL		has_shell_metachars(char *ptr);
 static long		filetime_to_clock(PFILETIME ft);
@@ -427,7 +427,7 @@ win32_os_id(void)
  * Returns number of words in result buffer.
  */
 static long
-tokenize(char *str, char **dest, char ***destv)
+tokenize(const char *str, char **dest, char ***destv)
 {
     char *retstart = Nullch;
     char **retvstart = 0;
@@ -485,8 +485,9 @@ get_shell(void)
 	 *     interactive use (which is what most programs look in COMSPEC
 	 *     for).
 	 */
-	char* defaultshell = (IsWinNT() ? "cmd.exe /x/c" : "command.com /c");
-	char *usershell = getenv("PERL5SHELL");
+	const char* defaultshell = (IsWinNT()
+				    ? "cmd.exe /x/c" : "command.com /c");
+	const char *usershell = getenv("PERL5SHELL");
 	w32_perlshell_items = tokenize(usershell ? usershell : defaultshell,
 				       &w32_perlshell_tokens,
 				       &w32_perlshell_vec);