X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/53c1dcc098c6cc47963786f1928061d90b5d30e1..aa0f650ec4a75cbd8e49db8ba715a9724f046b3a:/util.c

diff --git a/util.c b/util.c
index b5a2d49..6ef7a01 100644
--- a/util.c
+++ b/util.c
@@ -765,7 +765,7 @@ Perl_savepv(pTHX_ const char *pv)
 	char *newaddr;
 	const STRLEN pvlen = strlen(pv)+1;
 	New(902,newaddr,pvlen,char);
-	return strcpy(newaddr,pv);
+	return memcpy(newaddr,pv,pvlen);
     }
 
 }
@@ -812,16 +812,18 @@ char *
 Perl_savesharedpv(pTHX_ const char *pv)
 {
     register char *newaddr;
+    STRLEN pvlen;
     if (!pv)
 	return Nullch;
 
-    newaddr = (char*)PerlMemShared_malloc(strlen(pv)+1);
+    pvlen = strlen(pv)+1;
+    newaddr = (char*)PerlMemShared_malloc(pvlen);
     if (!newaddr) {
 	PerlLIO_write(PerlIO_fileno(Perl_error_log),
 		      PL_no_mem, strlen(PL_no_mem));
 	my_exit(1);
     }
-    return strcpy(newaddr,pv);
+    return memcpy(newaddr,pv,pvlen);
 }
 
 /*
@@ -950,7 +952,7 @@ Perl_mess(pTHX_ const char *pat, ...)
 }
 
 STATIC COP*
-S_closest_cop(pTHX_ COP *cop, OP *o)
+S_closest_cop(pTHX_ COP *cop, const OP *o)
 {
     /* Look for PL_op starting from o.  cop is the last COP we've seen. */
 
@@ -977,7 +979,7 @@ S_closest_cop(pTHX_ COP *cop, OP *o)
 
     /* Nothing found. */
 
-    return 0;
+    return Null(COP *);
 }
 
 SV *
@@ -1374,6 +1376,58 @@ Perl_vwarner(pTHX_ U32  err, const char* pat, va_list* args)
     }
 }
 
+/* implements the ckWARN? macros */
+
+bool
+Perl_ckwarn(pTHX_ U32 w)
+{
+    return
+	(
+	       isLEXWARN_on
+	    && PL_curcop->cop_warnings != pWARN_NONE
+	    && (
+		   PL_curcop->cop_warnings == pWARN_ALL
+		|| isWARN_on(PL_curcop->cop_warnings, unpackWARN1(w))
+		|| (unpackWARN2(w) &&
+		     isWARN_on(PL_curcop->cop_warnings, unpackWARN2(w)))
+		|| (unpackWARN3(w) &&
+		     isWARN_on(PL_curcop->cop_warnings, unpackWARN3(w)))
+		|| (unpackWARN4(w) &&
+		     isWARN_on(PL_curcop->cop_warnings, unpackWARN4(w)))
+		)
+	)
+	||
+	(
+	    isLEXWARN_off && PL_dowarn & G_WARN_ON
+	)
+	;
+}
+
+/* implements the ckWARN?_d macro */
+
+bool
+Perl_ckwarn_d(pTHX_ U32 w)
+{
+    return
+	   isLEXWARN_off
+	|| PL_curcop->cop_warnings == pWARN_ALL
+	|| (
+	      PL_curcop->cop_warnings != pWARN_NONE 
+	   && (
+		   isWARN_on(PL_curcop->cop_warnings, unpackWARN1(w))
+	      || (unpackWARN2(w) &&
+		   isWARN_on(PL_curcop->cop_warnings, unpackWARN2(w)))
+	      || (unpackWARN3(w) &&
+		   isWARN_on(PL_curcop->cop_warnings, unpackWARN3(w)))
+	      || (unpackWARN4(w) &&
+		   isWARN_on(PL_curcop->cop_warnings, unpackWARN4(w)))
+	      )
+	   )
+	;
+}
+
+
+
 /* since we've already done strlen() for both nam and val
  * we can use that info to make things faster than
  * sprintf(s, "%s=%s", nam, val)
@@ -2840,6 +2894,7 @@ Perl_find_script(pTHX_ const char *scriptname, bool dosearch, const char **searc
 		len = strlen(scriptname);
 		if (len+MAX_EXT_LEN+1 >= sizeof(tmpbuf))
 		    break;
+		/* FIXME? Convert to memcpy  */
 		cur = strcpy(tmpbuf, scriptname);
 	    }
 	} while (extidx >= 0 && ext[extidx]	/* try an extension? */
@@ -2894,15 +2949,17 @@ Perl_find_script(pTHX_ const char *scriptname, bool dosearch, const char **searc
 	    	tmpbuf[len++] = ':';
 #else
 	    if (len
-#if defined(atarist) || defined(__MINT__) || defined(DOSISH)
+#  if defined(atarist) || defined(__MINT__) || defined(DOSISH)
 		&& tmpbuf[len - 1] != '/'
 		&& tmpbuf[len - 1] != '\\'
-#endif
+#  endif
 	       )
 		tmpbuf[len++] = '/';
 	    if (len == 2 && tmpbuf[0] == '.')
 		seen_dot = 1;
 #endif
+	    /* FIXME? Convert to memcpy by storing previous strlen(scriptname)
+	     */
 	    (void)strcpy(tmpbuf + len, scriptname);
 #endif  /* !VMS */
 
@@ -2954,8 +3011,7 @@ Perl_find_script(pTHX_ const char *scriptname, bool dosearch, const char **searc
 	    }
 	    scriptname = Nullch;
 	}
-	if (xfailed)
-	    Safefree(xfailed);
+	Safefree(xfailed);
 	scriptname = xfound;
     }
     return (scriptname ? savepv(scriptname) : Nullch);
@@ -2988,7 +3044,7 @@ Perl_get_context(void)
 void
 Perl_set_context(void *t)
 {
-   dVAR;
+    dVAR;
 #if defined(USE_ITHREADS)
 #  ifdef I_MACH_CTHREADS
     cthread_set_data(cthread_self(), t);
@@ -2997,7 +3053,7 @@ Perl_set_context(void *t)
 	Perl_croak_nocontext("panic: pthread_setspecific");
 #  endif
 #else
-    (void)t;
+    PERL_UNUSED_ARG(t);
 #endif
 }
 
@@ -3046,7 +3102,7 @@ Perl_get_ppaddr(pTHX)
 char *
 Perl_getenv_len(pTHX_ const char *env_elem, unsigned long *len)
 {
-    char *env_trans = PerlEnv_getenv(env_elem);
+    char * const env_trans = PerlEnv_getenv(env_elem);
     if (env_trans)
 	*len = strlen(env_trans);
     return env_trans;
@@ -3340,11 +3396,13 @@ Perl_init_tm(pTHX_ struct tm *ptm)	/* see mktime, strftime and asctime */
 {
 #ifdef HAS_TM_TM_ZONE
     Time_t now;
-    struct tm* my_tm;
+    const struct tm* my_tm;
     (void)time(&now);
     my_tm = localtime(&now);
     if (my_tm)
         Copy(my_tm, ptm, 1, struct tm);
+#else
+    PERL_UNUSED_ARG(ptm);
 #endif
 }
 
@@ -4025,8 +4083,9 @@ Perl_new_version(pTHX_ SV *ver)
     if ( SvVOK(ver) ) { /* already a v-string */
 	char *version;
 	MAGIC* mg = mg_find(ver,PERL_MAGIC_vstring);
-	version = savepvn( (const char*)mg->mg_ptr,mg->mg_len );
-	sv_setpv(rv,version);
+	const STRLEN len = mg->mg_len;
+	version = savepvn( (const char*)mg->mg_ptr, len);
+	sv_setpvn(rv,version,len);
 	Safefree(version);
     }
     else {