{
register I32 tolen;
PERL_UNUSED_CONTEXT;
+
for (tolen = 0; from < fromend; from++, tolen++) {
if (*from == '\\') {
- if (from[1] == delim)
- from++;
- else {
+ if (from[1] != delim) {
if (to < toend)
*to++ = *from;
tolen++;
- from++;
}
+ from++;
}
else if (*from == delim)
break;
else {
char *newaddr;
const STRLEN pvlen = strlen(pv)+1;
- Newx(newaddr,pvlen,char);
- return memcpy(newaddr,pv,pvlen);
+ Newx(newaddr, pvlen, char);
+ return (char*)memcpy(newaddr, pv, pvlen);
}
}
if (!newaddr) {
return write_no_mem();
}
- return memcpy(newaddr,pv,pvlen);
+ return (char*)memcpy(newaddr, pv, pvlen);
}
/*
Perl_new_warnings_bitfield(pTHX_ STRLEN *buffer, const char *const bits,
STRLEN size) {
const MEM_SIZE len_wanted = sizeof(STRLEN) + size;
+ PERL_UNUSED_CONTEXT;
- buffer = specialWARN(buffer) ? PerlMemShared_malloc(len_wanted)
- : PerlMemShared_realloc(buffer, len_wanted);
+ buffer = (STRLEN*)
+ (specialWARN(buffer) ?
+ PerlMemShared_malloc(len_wanted) :
+ PerlMemShared_realloc(buffer, len_wanted));
buffer[0] = size;
Copy(bits, (buffer + 1), size, char);
return buffer;
I32 max;
char **tmpenv;
- for (max = i; environ[max]; max++) ;
+ max = i;
+ while (environ[max])
+ max++;
tmpenv = (char**)safesysmalloc((max+2) * sizeof(char*));
for (j=0; j<max; j++) { /* copy environment */
const int len = strlen(environ[j]);
I32
Perl_unlnk(pTHX_ const char *f) /* unlink all versions of a file */
{
- I32 i;
+ I32 retries = 0;
- for (i = 0; PerlLIO_unlink(f) >= 0; i++) ;
- return i ? 0 : -1;
+ while (PerlLIO_unlink(f) >= 0)
+ retries++;
+ return retries ? 0 : -1;
}
#endif
if ((strlen(tmpbuf) + strlen(scriptname)
+ MAX_EXT_LEN) >= sizeof tmpbuf)
continue; /* don't search dir with too-long name */
- strcat(tmpbuf, scriptname);
+ my_strlcat(tmpbuf, scriptname, sizeof(tmpbuf));
#else /* !VMS */
#ifdef DOSISH
len = strlen(scriptname);
if (len+MAX_EXT_LEN+1 >= sizeof(tmpbuf))
break;
- /* FIXME? Convert to memcpy */
- cur = strcpy(tmpbuf, scriptname);
+ my_strlcpy(tmpbuf, scriptname, sizeof(tmpbuf));
+ cur = tmpbuf;
}
} while (extidx >= 0 && ext[extidx] /* try an extension? */
- && strcpy(tmpbuf+len, ext[extidx++]));
+ && my_strlcpy(tmpbuf+len, ext[extidx++], sizeof(tmpbuf) - len));
#endif
}
#endif
if (len == 2 && tmpbuf[0] == '.')
seen_dot = 1;
#endif
-#ifdef HAS_STRLCAT
- (void)strlcpy(tmpbuf + len, scriptname, sizeof(tmpbuf) - len);
-#else
- /* FIXME? Convert to memcpy by storing previous strlen(scriptname)
- */
- (void)strcpy(tmpbuf + len, scriptname);
-#endif /* #ifdef HAS_STRLCAT */
+ (void)my_strlcpy(tmpbuf + len, scriptname, sizeof(tmpbuf) - len);
#endif /* !VMS */
#ifdef SEARCH_EXTS
#ifdef SEARCH_EXTS
} while ( retval < 0 /* not there */
&& extidx>=0 && ext[extidx] /* try an extension? */
- && strcpy(tmpbuf+len, ext[extidx++])
+ && my_strlcpy(tmpbuf+len, ext[extidx++], sizeof(tmpbuf) - len)
);
#endif
if (retval < 0)
if (op == OP_phoney_OUTPUT_ONLY || op == OP_phoney_INPUT_ONLY) {
if (ckWARN(WARN_IO)) {
- const char * const direction = (op == OP_phoney_INPUT_ONLY) ? "in" : "out";
+ const char * const direction =
+ (const char *)((op == OP_phoney_INPUT_ONLY) ? "in" : "out");
if (name && *name)
Perl_warner(aTHX_ packWARN(WARN_IO),
"Filehandle %s opened only for %sput",
}
if (ckWARN(warn_type)) {
- const char * const pars = OP_IS_FILETEST(op) ? "" : "()";
+ const char * const pars =
+ (const char *)(OP_IS_FILETEST(op) ? "" : "()");
const char * const func =
- op == OP_READLINE ? "readline" : /* "<HANDLE>" not nice */
- op == OP_LEAVEWRITE ? "write" : /* "write exit" not nice */
- op < 0 ? "" : /* handle phoney cases */
- PL_op_desc[op];
- const char * const type = OP_IS_SOCKET(op)
- || (gv && io && IoTYPE(io) == IoTYPE_SOCKET)
- ? "socket" : "filehandle";
+ (const char *)
+ (op == OP_READLINE ? "readline" : /* "<HANDLE>" not nice */
+ op == OP_LEAVEWRITE ? "write" : /* "write exit" not nice */
+ op < 0 ? "" : /* handle phoney cases */
+ PL_op_desc[op]);
+ const char * const type =
+ (const char *)
+ (OP_IS_SOCKET(op) ||
+ (gv && io && IoTYPE(io) == IoTYPE_SOCKET) ?
+ "socket" : "filehandle");
if (name && *name) {
Perl_warner(aTHX_ packWARN(warn_type),
"%s%s on %s %s %s", func, pars, vile, type, name);
/* Append revision */
av_push(av, newSViv(rev));
- if ( *pos == '.' && isDIGIT(pos[1]) )
+ if ( *pos == '.' )
s = ++pos;
else if ( *pos == '_' && isDIGIT(pos[1]) )
s = ++pos;
if ( av_len(av) == -1 ) /* oops, someone forgot to pass a value */
av_push(av, newSViv(0));
+ /* fix RT#19517 - special case 'undef' as string */
+ if ( *s == 'u' && strEQ(s,"undef") ) {
+ s += 5;
+ }
+
/* And finally, store the AV in the hash */
hv_store((HV *)hv, "version", 7, newRV_noinc((SV *)av), 0);
return s;
if ( SvNOK(ver) ) /* may get too much accuracy */
{
char tbuf[64];
- const STRLEN len = my_snprintf(tbuf, sizeof(tbuf), "%.9"NVgf, SvNVX(ver));
+ STRLEN len = my_snprintf(tbuf, sizeof(tbuf), "%.9"NVff, SvNVX(ver));
+ while (tbuf[len-1] == '0' && len > 0) len--;
version = savepvn(tbuf, len);
}
#ifdef SvVOK
{
version = savepv(SvPV_nolen(ver));
}
+
s = scan_version(version, ver, qv);
if ( *s != '\0' )
- if(ckWARN(WARN_MISC))
+ if(ckWARN(WARN_MISC))
Perl_warner(aTHX_ packWARN(WARN_MISC),
- "Version string '%s' contains invalid data; "
- "ignoring: '%s'", version, s);
+ "Version string '%s' contains invalid data; "
+ "ignoring: '%s'", version, s);
Safefree(version);
return ver;
}
if (*p) {
if (isDIGIT(*p)) {
opt = (U32) atoi(p);
- while (isDIGIT(*p)) p++;
+ while (isDIGIT(*p))
+ p++;
if (*p && *p != '\n' && *p != '\r')
Perl_croak(aTHX_ "Unknown Unicode option letter '%c'", *p);
}
UV myseed = 0;
if (s)
- while (isSPACE(*s)) s++;
+ while (isSPACE(*s))
+ s++;
if (s && isDIGIT(*s))
myseed = (UV)Atoul(s);
else
{
const STRLEN len =
my_snprintf(buf,
- PERL_MEM_LOG_SPRINTF_BUF_SIZE,
+ sizeof(buf),
# ifdef PERL_MEM_LOG_TIMESTAMP
"%10d.%06d: "
# endif
{
const STRLEN len =
my_snprintf(buf,
- PERL_MEM_LOG_SPRINTF_BUF_SIZE,
+ sizeof(buf),
# ifdef PERL_MEM_LOG_TIMESTAMP
"%10d.%06d: "
# endif
{
const STRLEN len =
my_snprintf(buf,
- PERL_MEM_LOG_SPRINTF_BUF_SIZE,
+ sizeof(buf),
# ifdef PERL_MEM_LOG_TIMESTAMP
"%10d.%06d: "
# endif
retval = vsprintf(buffer, format, ap);
#endif
va_end(ap);
- if (retval >= len)
+ /* vsnprintf() shows failure with >= len, vsprintf() with < 0 */
+ if (retval < 0 || (len > 0 && (Size_t)retval >= len))
Perl_croak(aTHX_ "panic: my_snprintf buffer overflow");
return retval;
}
int retval;
#ifdef NEED_VA_COPY
va_list apc;
- Perl_va_copy(apc);
+ Perl_va_copy(ap, apc);
# ifdef HAS_VSNPRINTF
retval = vsnprintf(buffer, len, format, apc);
# else
retval = vsprintf(buffer, format, ap);
# endif
#endif /* #ifdef NEED_VA_COPY */
- if (retval >= len)
+ /* vsnprintf() shows failure with >= len, vsprintf() with < 0 */
+ if (retval < 0 || (len > 0 && (Size_t)retval >= len))
Perl_croak(aTHX_ "panic: my_vsnprintf buffer overflow");
return retval;
}
(void)clearenv();
# elif defined(HAS_UNSETENV)
int bsiz = 80; /* Most envvar names will be shorter than this. */
- char *buf = (char*)safesysmalloc(bsiz * sizeof(char));
+ int bufsiz = bsiz * sizeof(char); /* sizeof(char) paranoid? */
+ char *buf = (char*)safesysmalloc(bufsiz);
while (*environ != NULL) {
char *e = strchr(*environ, '=');
int l = e ? e - *environ : strlen(*environ);
if (bsiz < l + 1) {
(void)safesysfree(buf);
- bsiz = l + 1;
- buf = (char*)safesysmalloc(bsiz * sizeof(char));
+ bsiz = l + 1; /* + 1 for the \0. */
+ buf = (char*)safesysmalloc(bufsiz);
}
- strncpy(buf, *environ, l);
- *(buf + l) = '\0';
+ my_strlcpy(buf, *environ, l + 1);
(void)unsetenv(buf);
}
(void)safesysfree(buf);
}
#endif
+#ifndef HAS_STRLCAT
+Size_t
+Perl_my_strlcat(char *dst, const char *src, Size_t size)
+{
+ Size_t used, length, copy;
+
+ used = strlen(dst);
+ length = strlen(src);
+ if (size > 0 && used < size - 1) {
+ copy = (length >= size - used) ? size - used - 1 : length;
+ memcpy(dst + used, src, copy);
+ dst[used + copy] = '\0';
+ }
+ return used + length;
+}
+#endif
+
+#ifndef HAS_STRLCPY
+Size_t
+Perl_my_strlcpy(char *dst, const char *src, Size_t size)
+{
+ Size_t length, copy;
+
+ length = strlen(src);
+ if (size > 0) {
+ copy = (length >= size) ? size - 1 : length;
+ memcpy(dst, src, copy);
+ dst[copy] = '\0';
+ }
+ return length;
+}
+#endif
+
/*
* Local variables:
* c-indentation-style: bsd
https://perl5.git.perl.org / perl5.git / blobdiff