}
}
+const char *
+Perl_cntrl_to_mnemonic(const U8 c)
+{
+ /* Returns the mnemonic string that represents character 'c', if one
+ * exists; NULL otherwise. The only ones that exist for the purposes of
+ * this routine are a few control characters */
+
+ switch (c) {
+ case '\a': return "\\a";
+ case '\b': return "\\b";
+ case ESC_NATIVE: return "\\e";
+ case '\f': return "\\f";
+ case '\n': return "\\n";
+ case '\r': return "\\r";
+ case '\t': return "\\t";
+ }
+
+ return NULL;
+}
+
/* copy a string to a safe spot */
/*
Perl's version of C<strdup()>. Returns a pointer to a newly allocated
string which is a duplicate of C<pv>. The size of the string is
determined by C<strlen()>, which means it may not contain embedded C<NUL>
-characters and must have a trailing C<NUL>. The memory allocated for the new
-string can be freed with the C<Safefree()> function.
+characters and must have a trailing C<NUL>. To prevent memory leaks, the
+memory allocated for the new string needs to be freed when no longer needed.
+This can be done with the L</C<Safefree>> function, or
+L<C<SAVEFREEPV>|perlguts/SAVEFREEPV(p)>.
On some platforms, Windows for example, all allocated memory owned by a thread
is deallocated when that thread ends. So if you need that not to happen, you
*/
char *
-Perl_savepvn(pTHX_ const char *pv, I32 len)
+Perl_savepvn(pTHX_ const char *pv, Size_t len)
{
char *newaddr;
PERL_UNUSED_CONTEXT;
- assert(len >= 0);
-
Newx(newaddr,len+1,char);
/* Give a meaning to NULL pointer mainly for the use in sv_magic() */
if (pv) {
}
#endif /* PERL_IMPLICIT_CONTEXT */
+/* saves machine code for a common noreturn idiom typically used in Newx*() */
+GCC_DIAG_IGNORE_DECL(-Wunused-function);
+void
+Perl_croak_memory_wrap(void)
+{
+ Perl_croak_nocontext("%s",PL_memory_wrap);
+}
+GCC_DIAG_RESTORE_DECL;
+
void
Perl_croak(pTHX_ const char *pat, ...)
{
# endif
# ifdef USE_ITHREADS
- /* only parent thread can modify process environment */
+ /* only parent thread can modify process environment, so no need to use a
+ * mutex */
if (PL_curinterp == aTHX)
# endif
{
Perl_init_tm(pTHX_ struct tm *ptm) /* see mktime, strftime and asctime */
{
#ifdef HAS_TM_TM_ZONE
+ dVAR;
Time_t now;
const struct tm* my_tm;
PERL_UNUSED_CONTEXT;
PERL_ARGS_ASSERT_INIT_TM;
(void)time(&now);
+ ENV_LOCALE_READ_LOCK;
my_tm = localtime(&now);
if (my_tm)
Copy(my_tm, ptm, 1, struct tm);
+ ENV_LOCALE_READ_UNLOCK;
#else
PERL_UNUSED_CONTEXT;
PERL_ARGS_ASSERT_INIT_TM;
** If there is a better way to make it portable, go ahead by
** all means.
*/
- if ((len > 0 && len < buflen) || (len == 0 && *fmt == '\0'))
+ if (inRANGE(len, 1, buflen - 1) || (len == 0 && *fmt == '\0'))
return buf;
else {
/* Possibly buf overflowed - try again with a bigger buf */
buflen = strftime(buf, bufsize, fmt, &mytm);
GCC_DIAG_RESTORE_STMT;
- if (buflen > 0 && buflen < bufsize)
+ if (inRANGE(buflen, 1, bufsize - 1))
break;
/* heuristic to prevent out-of-memory errors */
if (bufsize > 100*fmtlen) {
return FALSE;
len = strlen(format);
/* minimum length three: %Qg */
- if (len < 3 || strchr("efgaEFGA", format[len - 1]) == NULL)
+ if (len < 3 || memCHRs("efgaEFGA", format[len - 1]) == NULL)
return FALSE;
if (format[len - 2] != 'Q')
return FALSE;
else
while (isDIGIT(*q)) q++;
}
- if (strchr("efgaEFGA", *q)) /* Would have needed 'Q' in front. */
+ if (memCHRs("efgaEFGA", *q)) /* Would have needed 'Q' in front. */
return TRUE;
p = q + 1;
}
# else /* ! (PERL_IMPLICIT_SYS || WIN32) */
# if defined(USE_ENVIRON_ARRAY)
# if defined(USE_ITHREADS)
- /* only the parent thread can clobber the process environment */
+ /* only the parent thread can clobber the process environment, so no need
+ * to use a mutex */
if (PL_curinterp == aTHX)
# endif /* USE_ITHREADS */
{
}
#endif
-/*
-=for apidoc my_strnlen
-
-The C library C<strnlen> if available, or a Perl implementation of it.
-
-C<my_strnlen()> computes the length of the string, up to C<maxlen>
-characters. It will will never attempt to address more than C<maxlen>
-characters, making it suitable for use with strings that are not
-guaranteed to be NUL-terminated.
-
-=cut
-
-Description stolen from http://man.openbsd.org/strnlen.3,
-implementation stolen from PostgreSQL.
-*/
-#ifndef HAS_STRNLEN
-Size_t
-Perl_my_strnlen(const char *str, Size_t maxlen)
-{
- const char *p = str;
-
- PERL_ARGS_ASSERT_MY_STRNLEN;
-
- while(maxlen-- && *p)
- p++;
-
- return p - str;
-}
-#endif
-
#if defined(_MSC_VER) && (_MSC_VER >= 1300) && (_MSC_VER < 1400) && (WINVER < 0x0500)
/* VC7 or 7.1, building with pre-VC7 runtime libraries. */
long _ftol( double ); /* Defined by VC6 C libs. */
https://perl5.git.perl.org / perl5.git / blobdiff