X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=util.c;h=53e2e7b05b813c906f93ed0f7a18089330eb5888;hb=55082927c3a5e85aa9f9d6c8e76cacf11d232232;hp=9a90549ae687f9ce3b1a671800f522612910ca9e;hpb=50acdf951a03f778010b5632532ec99bfa7c4f6a;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/util.c b/util.c
index 9a90549..53e2e7b 100644
--- a/util.c
+++ b/util.c
@@ -1,7 +1,7 @@
 /*    util.c
  *
  *    Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -224,7 +224,7 @@ Free_t   Perl_mfree (Malloc_t where)
 /* copy a string up to some (non-backslashed) delimiter, if any */
 
 char *
-Perl_delimcpy(pTHX_ register char *to, register char *toend, register char *from, register char *fromend, register int delim, I32 *retlen)
+Perl_delimcpy(pTHX_ register char *to, register const char *toend, register const char *from, register const char *fromend, register int delim, I32 *retlen)
 {
     register I32 tolen;
     for (tolen = 0; from < fromend; from++, tolen++) {
@@ -246,7 +246,7 @@ Perl_delimcpy(pTHX_ register char *to, register char *toend, register char *from
     if (to < toend)
 	*to = '\0';
     *retlen = tolen;
-    return from;
+    return (char *)from;
 }
 
 /* return ptr to little string in big string, NULL if not found */
@@ -286,7 +286,7 @@ char *
 Perl_ninstr(pTHX_ register const char *big, register const char *bigend, const char *little, const char *lend)
 {
     register const char *s, *x;
-    register I32 first = *little;
+    register const I32 first = *little;
     register const char *littleend = lend;
 
     if (!first && little >= littleend)
@@ -316,7 +316,7 @@ Perl_rninstr(pTHX_ register const char *big, const char *bigend, const char *lit
 {
     register const char *bigbeg;
     register const char *s, *x;
-    register I32 first = *little;
+    register const I32 first = *little;
     register const char *littleend = lend;
 
     if (!first && little >= littleend)
@@ -439,14 +439,14 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit
     STRLEN l;
     register unsigned char *little = (unsigned char *)SvPV(littlestr,l);
     register STRLEN littlelen = l;
-    register I32 multiline = flags & FBMrf_MULTILINE;
+    register const I32 multiline = flags & FBMrf_MULTILINE;
 
     if ((STRLEN)(bigend - big) < littlelen) {
 	if ( SvTAIL(littlestr)
 	     && ((STRLEN)(bigend - big) == littlelen - 1)
 	     && (littlelen == 1
 		 || (*big == *little &&
-		     memEQ((char *)big, (char *)little, littlelen - 1))))
+		     memEQ(big, little, littlelen - 1))))
 	    return (char*)big;
 	return Nullch;
     }
@@ -567,7 +567,7 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit
     }
 
     {	/* Do actual FBM.  */
-	register unsigned char *table = little + littlelen + FBM_TABLE_OFFSET;
+	register const unsigned char *table = little + littlelen + FBM_TABLE_OFFSET;
 	register unsigned char *oldlittle;
 
 	if (littlelen > (STRLEN)(bigend - big))
@@ -716,8 +716,8 @@ Perl_screaminstr(pTHX_ SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift
 I32
 Perl_ibcmp(pTHX_ const char *s1, const char *s2, register I32 len)
 {
-    register U8 *a = (U8 *)s1;
-    register U8 *b = (U8 *)s2;
+    register const U8 *a = (const U8 *)s1;
+    register const U8 *b = (const U8 *)s2;
     while (len--) {
 	if (*a != *b && *a != PL_fold[*b])
 	    return 1;
@@ -729,8 +729,8 @@ Perl_ibcmp(pTHX_ const char *s1, const char *s2, register I32 len)
 I32
 Perl_ibcmp_locale(pTHX_ const char *s1, const char *s2, register I32 len)
 {
-    register U8 *a = (U8 *)s1;
-    register U8 *b = (U8 *)s2;
+    register const U8 *a = (const U8 *)s1;
+    register const U8 *b = (const U8 *)s2;
     while (len--) {
 	if (*a != *b && *a != PL_fold_locale[*b])
 	    return 1;
@@ -758,10 +758,18 @@ char *
 Perl_savepv(pTHX_ const char *pv)
 {
     register char *newaddr;
+#ifdef PERL_MALLOC_WRAP
+    STRLEN pvlen;
+#endif
     if (!pv)
 	return Nullch;
 
+#ifdef PERL_MALLOC_WRAP
+    pvlen = strlen(pv)+1;
+    New(902,newaddr,pvlen,char);
+#else
     New(902,newaddr,strlen(pv)+1,char);
+#endif
     return strcpy(newaddr,pv);
 }
 
@@ -788,10 +796,10 @@ Perl_savepvn(pTHX_ const char *pv, register I32 len)
     if (pv) {
 	/* might not be null terminated */
     	newaddr[len] = '\0';
-    	return CopyD(pv,newaddr,len,char);
+    	return (char *) CopyD(pv,newaddr,len,char);
     }
     else {
-	return ZeroD(newaddr,len+1,char);
+	return (char *) ZeroD(newaddr,len+1,char);
     }
 }
 
@@ -819,6 +827,26 @@ Perl_savesharedpv(pTHX_ const char *pv)
     return strcpy(newaddr,pv);
 }
 
+/*
+=for apidoc savesvpv
+
+A version of C<savepv()>/C<savepvn()> which gets the string to duplicate from
+the passed in SV using C<SvPV()>
+
+=cut
+*/
+
+char *
+Perl_savesvpv(pTHX_ SV *sv)
+{
+    STRLEN len;
+    const char *pv = SvPV(sv, len);
+    register char *newaddr;
+
+    ++len;
+    New(903,newaddr,len,char);
+    return (char *) CopyD(pv,newaddr,len,char);
+}
 
 
 /* the SV for Perl_form() and mess() is not kept in an arena */
@@ -959,7 +987,6 @@ Perl_vmess(pTHX_ const char *pat, va_list *args)
 {
     SV *sv = mess_alloc();
     static char dgd[] = " during global destruction.\n";
-    COP *cop;
 
     sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
     if (!SvCUR(sv) || *(SvEND(sv) - 1) != '\n') {
@@ -971,14 +998,14 @@ Perl_vmess(pTHX_ const char *pat, va_list *args)
 	 * from the sibling of PL_curcop.
 	 */
 
-	cop = closest_cop(PL_curcop, PL_curcop->op_sibling);
+	const COP *cop = closest_cop(PL_curcop, PL_curcop->op_sibling);
 	if (!cop) cop = PL_curcop;
 
 	if (CopLINE(cop))
 	    Perl_sv_catpvf(aTHX_ sv, " at %s line %"IVdf,
 	    OutCopFILE(cop), (IV)CopLINE(cop));
 	if (GvIO(PL_last_in_gv) && IoLINES(GvIOp(PL_last_in_gv))) {
-	    bool line_mode = (RsSIMPLE(PL_rs) &&
+	    const bool line_mode = (RsSIMPLE(PL_rs) &&
 			      SvCUR(PL_rs) == 1 && *SvPVX(PL_rs) == '\n');
 	    Perl_sv_catpvf(aTHX_ sv, ", <%s> %s %"IVdf,
 			   PL_last_in_gv == PL_argvgv ?
@@ -1041,7 +1068,7 @@ Perl_write_to_stderr(pTHX_ const char* message, int msglen)
 
 void S_vdie_common(pTHX_ const char *message, STRLEN msglen, I32 utf8);
 
-char *
+STATIC char *
 S_vdie_croak_common(pTHX_ const char* pat, va_list* args, STRLEN* msglen,
 		    I32* utf8)
 {
@@ -1115,8 +1142,8 @@ S_vdie_common(pTHX_ const char *message, STRLEN msglen, I32 utf8)
 OP *
 Perl_vdie(pTHX_ const char* pat, va_list *args)
 {
-    char *message;
-    int was_in_eval = PL_in_eval;
+    const char *message;
+    const int was_in_eval = PL_in_eval;
     STRLEN msglen;
     I32 utf8 = 0;
 
@@ -1164,7 +1191,7 @@ Perl_die(pTHX_ const char* pat, ...)
 void
 Perl_vcroak(pTHX_ const char* pat, va_list *args)
 {
-    char *message;
+    const char *message;
     STRLEN msglen;
     I32 utf8 = 0;
 
@@ -1330,7 +1357,7 @@ Perl_vwarner(pTHX_ U32  err, const char* pat, va_list* args)
     if (ckDEAD(err)) {
 	SV *msv = vmess(pat, args);
 	STRLEN msglen;
-	char *message = SvPV(msv, msglen);
+	const char *message = SvPV(msv, msglen);
 	I32 utf8 = SvUTF8(msv);
 
 	if (PL_diehook) {
@@ -1364,7 +1391,7 @@ Perl_vwarner(pTHX_ U32  err, const char* pat, va_list* args)
        /* VMS' my_setenv() is in vms.c */
 #if !defined(WIN32) && !defined(NETWARE)
 void
-Perl_my_setenv(pTHX_ char *nam, char *val)
+Perl_my_setenv(pTHX_ const char *nam, const char *val)
 {
 #ifdef USE_ITHREADS
   /* only parent thread can modify process environment */
@@ -1386,7 +1413,7 @@ Perl_my_setenv(pTHX_ char *nam, char *val)
 	for (max = i; environ[max]; max++) ;
 	tmpenv = (char**)safesysmalloc((max+2) * sizeof(char*));
 	for (j=0; j<max; j++) {		/* copy environment */
-	    int len = strlen(environ[j]);
+	    const int len = strlen(environ[j]);
 	    tmpenv[j] = (char*)safesysmalloc((len+1)*sizeof(char));
 	    Copy(environ[j], tmpenv[j], len+1, char);
 	}
@@ -1438,10 +1465,11 @@ Perl_my_setenv(pTHX_ char *nam, char *val)
 #else /* WIN32 || NETWARE */
 
 void
-Perl_my_setenv(pTHX_ char *nam,char *val)
+Perl_my_setenv(pTHX_ const char *nam, const char *val)
 {
     register char *envstr;
-    int nlen = strlen(nam), vlen;
+    const int nlen = strlen(nam);
+    int vlen;
 
     if (!val) {
 	val = "";
@@ -1457,7 +1485,7 @@ Perl_my_setenv(pTHX_ char *nam,char *val)
 
 #ifndef PERL_MICRO
 I32
-Perl_setenv_getix(pTHX_ char *nam)
+Perl_setenv_getix(pTHX_ const char *nam)
 {
     register I32 i, len = strlen(nam);
 
@@ -1540,8 +1568,8 @@ Perl_my_bzero(register char *loc, register I32 len)
 I32
 Perl_my_memcmp(const char *s1, const char *s2, register I32 len)
 {
-    register U8 *a = (U8 *)s1;
-    register U8 *b = (U8 *)s2;
+    register const U8 *a = (const U8 *)s1;
+    register const U8 *b = (const U8 *)s2;
     register I32 tmp;
 
     while (len--) {
@@ -2045,7 +2073,7 @@ Perl_my_popen(pTHX_ char *cmd, char *mode)
     register I32 This, that;
     register Pid_t pid;
     SV *sv;
-    I32 doexec = strNE(cmd,"-");
+    I32 doexec = !(*cmd == '-' && cmd[1] == '\0');
     I32 did_pipes = 0;
     int pp[2];
 
@@ -2539,7 +2567,7 @@ Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags)
     {
 	SV *sv;
 	SV** svp;
-	char spid[TYPE_CHARS(int)];
+	char spid[TYPE_CHARS(IV)];
 
 	if (pid > 0) {
 	    sprintf(spid, "%"IVdf, (IV)pid);
@@ -2555,9 +2583,6 @@ Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags)
 
 	    hv_iterinit(PL_pidstatus);
 	    if ((entry = hv_iternext(PL_pidstatus))) {
-		SV *sv;
-		char spid[TYPE_CHARS(int)];
-
 		pid = atoi(hv_iterkey(entry,(I32*)statusp));
 		sv = hv_iterval(PL_pidstatus,entry);
 		*statusp = SvIVX(sv);
@@ -2606,7 +2631,7 @@ void
 Perl_pidgone(pTHX_ Pid_t pid, int status)
 {
     register SV *sv;
-    char spid[TYPE_CHARS(int)];
+    char spid[TYPE_CHARS(IV)];
 
     sprintf(spid, "%"IVdf, (IV)pid);
     sv = *hv_fetch(PL_pidstatus,spid,strlen(spid),TRUE);
@@ -2706,9 +2731,9 @@ Perl_same_dirent(pTHX_ char *a, char *b)
 #endif /* !HAS_RENAME */
 
 char*
-Perl_find_script(pTHX_ char *scriptname, bool dosearch, char **search_ext, I32 flags)
+Perl_find_script(pTHX_ const char *scriptname, bool dosearch, const char **search_ext, I32 flags)
 {
-    char *xfound = Nullch;
+    const char *xfound = Nullch;
     char *xfailed = Nullch;
     char tmpbuf[MAXPATHLEN];
     register char *s;
@@ -2728,11 +2753,12 @@ Perl_find_script(pTHX_ char *scriptname, bool dosearch, char **search_ext, I32 f
 #endif
     /* additional extensions to try in each dir if scriptname not found */
 #ifdef SEARCH_EXTS
-    char *exts[] = { SEARCH_EXTS };
-    char **ext = search_ext ? search_ext : exts;
+    const char *exts[] = { SEARCH_EXTS };
+    const char **ext = search_ext ? search_ext : exts;
     int extidx = 0, i = 0;
-    char *curext = Nullch;
+    const char *curext = Nullch;
 #else
+    (void)search_ext;
 #  define MAX_EXT_LEN 0
 #endif
 
@@ -2790,7 +2816,7 @@ Perl_find_script(pTHX_ char *scriptname, bool dosearch, char **search_ext, I32 f
     if (strEQ(scriptname, "-"))
  	dosearch = 0;
     if (dosearch) {		/* Look in '.' first. */
-	char *cur = scriptname;
+	const char *cur = scriptname;
 #ifdef SEARCH_EXTS
 	if ((curext = strrchr(scriptname,'.')))	/* possible current ext */
 	    while (ext[i])
@@ -2994,10 +3020,10 @@ Perl_get_op_descs(pTHX)
  return PL_op_desc;
 }
 
-char *
+const char *
 Perl_get_no_modify(pTHX)
 {
- return (char*)PL_no_modify;
+ return PL_no_modify;
 }
 
 U32 *
@@ -3177,17 +3203,17 @@ Perl_my_fflush_all(pTHX)
 }
 
 void
-Perl_report_evil_fh(pTHX_ GV *gv, IO *io, I32 op)
+Perl_report_evil_fh(pTHX_ const GV *gv, const IO *io, I32 op)
 {
-    char *func =
+    const char *func =
 	op == OP_READLINE   ? "readline"  :	/* "<HANDLE>" not nice */
 	op == OP_LEAVEWRITE ? "write" :		/* "write exit" not nice */
 	PL_op_desc[op];
-    char *pars = OP_IS_FILETEST(op) ? "" : "()";
-    char *type = OP_IS_SOCKET(op)
+    const char *pars = OP_IS_FILETEST(op) ? "" : "()";
+    const char *type = OP_IS_SOCKET(op)
 	    || (gv && io && IoTYPE(io) == IoTYPE_SOCKET)
 		?  "socket" : "filehandle";
-    char *name = NULL;
+    const char *name = NULL;
 
     if (gv && isGV(gv)) {
 	name = GvENAME(gv);
@@ -3206,7 +3232,7 @@ Perl_report_evil_fh(pTHX_ GV *gv, IO *io, I32 op)
 	}
     }
     else {
-	char *vile;
+        const char *vile;
 	I32   warn_type;
 
 	if (gv && io && IoTYPE(io) == IoTYPE_CLOSED) {
@@ -3251,7 +3277,7 @@ int
 Perl_ebcdic_control(pTHX_ int ch)
 {
     if (ch > 'a') {
-	char *ctlp;
+	const char *ctlp;
 
 	if (islower(ch))
 	    ch = toupper(ch);
@@ -3513,7 +3539,7 @@ Perl_mini_mktime(pTHX_ struct tm *ptm)
 }
 
 char *
-Perl_my_strftime(pTHX_ char *fmt, int sec, int min, int hour, int mday, int mon, int year, int wday, int yday, int isdst)
+Perl_my_strftime(pTHX_ const char *fmt, int sec, int min, int hour, int mday, int mon, int year, int wday, int yday, int isdst)
 {
 #ifdef HAS_STRFTIME
   char *buf;
@@ -3567,8 +3593,8 @@ Perl_my_strftime(pTHX_ char *fmt, int sec, int min, int hour, int mday, int mon,
     return buf;
   else {
     /* Possibly buf overflowed - try again with a bigger buf */
-    int     fmtlen = strlen(fmt);
-    int	    bufsize = fmtlen + buflen;
+    const int fmtlen = strlen(fmt);
+    const int bufsize = fmtlen + buflen;
 
     New(0, buf, bufsize, char);
     while (buf) {
@@ -3581,8 +3607,7 @@ Perl_my_strftime(pTHX_ char *fmt, int sec, int min, int hour, int mday, int mon,
 	buf = NULL;
 	break;
       }
-      bufsize *= 2;
-      Renew(buf, bufsize, char);
+      Renew(buf, bufsize*2, char);
     }
     return buf;
   }
@@ -3788,10 +3813,10 @@ it doesn't.
 */
 
 char *
-Perl_scan_version(pTHX_ char *s, SV *rv, bool qv)
+Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv)
 {
     const char *start = s;
-    char *pos = s;
+    const char *pos = s;
     I32 saw_period = 0;
     bool saw_under = 0;
     SV* sv = newSVrv(rv, "version"); /* create an SV and upgrade the RV */
@@ -3832,7 +3857,7 @@ Perl_scan_version(pTHX_ char *s, SV *rv, bool qv)
 	    rev = 0;
 	    {
   		/* this is atoi() that delimits on underscores */
-  		char *end = pos;
+		const char *end = pos;
   		I32 mult = 1;
  		I32 orev;
   		if ( s < pos && s > start && *(s-1) == '_' ) {
@@ -3894,7 +3919,7 @@ Perl_scan_version(pTHX_ char *s, SV *rv, bool qv)
 	while (len-- > 0)
 	    av_push((AV *)sv, newSViv(0));
     }
-    return s;
+    return (char *)s;
 }
 
 /*
@@ -3979,8 +4004,7 @@ Perl_upg_version(pTHX_ SV *ver)
 #endif
     else /* must be a string or something like a string */
     {
-	STRLEN n_a;
-	version = savepv(SvPV(ver,n_a));
+	version = savesvpv(ver);
     }
     (void)scan_version(version, ver, qv);
     Safefree(version);
@@ -4442,6 +4466,7 @@ some level of strict-ness.
 void
 Perl_sv_nosharing(pTHX_ SV *sv)
 {
+    (void)sv;
 }
 
 /*
@@ -4457,6 +4482,7 @@ some level of strict-ness.
 void
 Perl_sv_nolocking(pTHX_ SV *sv)
 {
+    (void)sv;
 }
 
 
@@ -4473,12 +4499,13 @@ some level of strict-ness.
 void
 Perl_sv_nounlocking(pTHX_ SV *sv)
 {
+    (void)sv;
 }
 
 U32
-Perl_parse_unicode_opts(pTHX_ char **popt)
+Perl_parse_unicode_opts(pTHX_ const char **popt)
 {
-  char *p = *popt;
+  const char *p = *popt;
   U32 opt = 0;
 
   if (*p) {
@@ -4613,7 +4640,7 @@ Perl_seed(pTHX)
 UV
 Perl_get_hash_seed(pTHX)
 {
-     char *s = PerlEnv_getenv("PERL_HASH_SEED");
+     const char *s = PerlEnv_getenv("PERL_HASH_SEED");
      UV myseed = 0;
 
      if (s)