? ((struct perl_memory_debug_header *)((char *)where - PERL_MEMORY_DEBUG_HEADER_SIZE))->size
: 0;
#endif
-#if !defined(STANDARD_C) && !defined(HAS_REALLOC_PROTOTYPE) && !defined(PERL_MICRO)
- Malloc_t PerlMem_realloc();
-#endif /* !defined(STANDARD_C) && !defined(HAS_REALLOC_PROTOTYPE) */
if (!size) {
safesysfree(where);
return (char*)big;
{
const char first = *little;
- const char *s, *x;
bigend -= lend - little++;
OUTER:
while (big <= bigend) {
if (*big++ == first) {
+ const char *s, *x;
for (x=big,s=little; s < lend; x++,s++) {
if (*s != *x)
goto OUTER;
PERL_ARGS_ASSERT_FBM_INSTR;
+ assert(bigend >= big);
+
if ((STRLEN)(bigend - big) < littlelen) {
if ( tail
&& ((STRLEN)(bigend - big) == littlelen - 1)
char * const b = ninstr((char*)big,(char*)bigend,
(char*)little, (char*)little + littlelen);
- if (!b && tail) { /* Automatically multiline! */
- /* Chop \n from littlestr: */
- s = bigend - littlelen + 1;
- if (*s == *little
- && memEQ((char*)s + 1, (char*)little + 1, littlelen - 2))
- {
- return (char*)s;
- }
- return NULL;
- }
+ assert(!tail); /* valid => FBM; tail only set on SvVALID SVs */
return b;
}
}
}
-
-/*
-=for apidoc foldEQ
-
-Returns true if the leading C<len> bytes of the strings C<s1> and C<s2> are the
-same
-case-insensitively; false otherwise. Uppercase and lowercase ASCII range bytes
-match themselves and their opposite case counterparts. Non-cased and non-ASCII
-range bytes match only themselves.
-
-=cut
-*/
-
-
-I32
-Perl_foldEQ(const char *s1, const char *s2, I32 len)
-{
- const U8 *a = (const U8 *)s1;
- const U8 *b = (const U8 *)s2;
-
- PERL_ARGS_ASSERT_FOLDEQ;
-
- assert(len >= 0);
-
- while (len--) {
- if (*a != *b && *a != PL_fold[*b])
- return 0;
- a++,b++;
- }
- return 1;
-}
-I32
-Perl_foldEQ_latin1(const char *s1, const char *s2, I32 len)
-{
- /* Compare non-utf8 using Unicode (Latin1) semantics. Does not work on
- * MICRO_SIGN, LATIN_SMALL_LETTER_SHARP_S, nor
- * LATIN_SMALL_LETTER_Y_WITH_DIAERESIS, and does not check for these. Nor
- * does it check that the strings each have at least 'len' characters */
-
- const U8 *a = (const U8 *)s1;
- const U8 *b = (const U8 *)s2;
-
- PERL_ARGS_ASSERT_FOLDEQ_LATIN1;
-
- assert(len >= 0);
-
- while (len--) {
- if (*a != *b && *a != PL_fold_latin1[*b]) {
- return 0;
- }
- a++, b++;
- }
- return 1;
-}
-
-/*
-=for apidoc foldEQ_locale
-
-Returns true if the leading C<len> bytes of the strings C<s1> and C<s2> are the
-same case-insensitively in the current locale; false otherwise.
-
-=cut
-*/
-
-I32
-Perl_foldEQ_locale(const char *s1, const char *s2, I32 len)
-{
- dVAR;
- const U8 *a = (const U8 *)s1;
- const U8 *b = (const U8 *)s2;
-
- PERL_ARGS_ASSERT_FOLDEQ_LOCALE;
-
- assert(len >= 0);
-
- while (len--) {
- if (*a != *b && *a != PL_fold_locale[*b])
- return 0;
- a++,b++;
- }
- return 1;
-}
-
/* copy a string to a safe spot */
/*
* from the sibling of PL_curcop.
*/
- const COP *cop =
- closest_cop(PL_curcop, OpSIBLING(PL_curcop), PL_op, FALSE);
- if (!cop)
- cop = PL_curcop;
+ if (PL_curcop) {
+ const COP *cop =
+ closest_cop(PL_curcop, OpSIBLING(PL_curcop), PL_op, FALSE);
+ if (!cop)
+ cop = PL_curcop;
+
+ if (CopLINE(cop))
+ Perl_sv_catpvf(aTHX_ sv, " at %s line %" IVdf,
+ OutCopFILE(cop), (IV)CopLINE(cop));
+ }
- if (CopLINE(cop))
- Perl_sv_catpvf(aTHX_ sv, " at %s line %" IVdf,
- OutCopFILE(cop), (IV)CopLINE(cop));
/* Seems that GvIO() can be untrustworthy during global destruction. */
if (GvIO(PL_last_in_gv) && (SvTYPE(GvIOp(PL_last_in_gv)) == SVt_PVIO)
&& IoLINES(GvIOp(PL_last_in_gv)))
# else /* ! HAS_UNSETENV */
(void)setenv(nam, val, 1);
# endif /* HAS_UNSETENV */
-# else
-# if defined(HAS_UNSETENV)
+# elif defined(HAS_UNSETENV)
if (val == NULL) {
if (environ) /* old glibc can crash with null environ */
(void)unsetenv(nam);
my_setenv_format(new_env, nam, nlen, val, vlen);
(void)putenv(new_env);
}
-# else /* ! HAS_UNSETENV */
+# else /* ! HAS_UNSETENV */
char *new_env;
const int nlen = strlen(nam);
int vlen;
/* all that work just for this */
my_setenv_format(new_env, nam, nlen, val, vlen);
(void)putenv(new_env);
-# endif /* HAS_UNSETENV */
# endif /* __CYGWIN__ */
#ifndef PERL_USE_SAFE_PUTENV
}
}
#endif
-/* this is a drop-in replacement for bcopy(), except for the return
- * value, which we need to be able to emulate memcpy() */
-#if !defined(HAS_MEMCPY) || (!defined(HAS_MEMMOVE) && !defined(HAS_SAFE_MEMCPY))
-void *
-Perl_my_bcopy(const void *vfrom, void *vto, size_t len)
-{
-#if defined(HAS_BCOPY) && defined(HAS_SAFE_BCOPY)
- bcopy(vfrom, vto, len);
-#else
- const unsigned char *from = (const unsigned char *)vfrom;
- unsigned char *to = (unsigned char *)vto;
-
- PERL_ARGS_ASSERT_MY_BCOPY;
-
- if (from - to >= 0) {
- while (len--)
- *to++ = *from++;
- }
- else {
- to += len;
- from += len;
- while (len--)
- *(--to) = *(--from);
- }
-#endif
-
- return vto;
-}
-#endif
-
-/* this is a drop-in replacement for memset() */
-#ifndef HAS_MEMSET
-void *
-Perl_my_memset(void *vloc, int ch, size_t len)
-{
- unsigned char *loc = (unsigned char *)vloc;
-
- PERL_ARGS_ASSERT_MY_MEMSET;
-
- while (len--)
- *loc++ = ch;
- return vloc;
-}
-#endif
-
-/* this is a drop-in replacement for bzero() */
-#if !defined(HAS_BZERO) && !defined(HAS_MEMSET)
-void *
-Perl_my_bzero(void *vloc, size_t len)
-{
- unsigned char *loc = (unsigned char *)vloc;
-
- PERL_ARGS_ASSERT_MY_BZERO;
-
- while (len--)
- *loc++ = 0;
- return vloc;
-}
-#endif
-
-/* this is a drop-in replacement for memcmp() */
-#if !defined(HAS_MEMCMP) || !defined(HAS_SANE_MEMCMP)
-int
-Perl_my_memcmp(const void *vs1, const void *vs2, size_t len)
-{
- const U8 *a = (const U8 *)vs1;
- const U8 *b = (const U8 *)vs2;
- int tmp;
-
- PERL_ARGS_ASSERT_MY_MEMCMP;
-
- while (len--) {
- if ((tmp = *a++ - *b++))
- return tmp;
- }
- return 0;
-}
-#endif /* !HAS_MEMCMP || !HAS_SANE_MEMCMP */
-
-#ifndef HAS_VPRINTF
-/* This vsprintf replacement should generally never get used, since
- vsprintf was available in both System V and BSD 2.11. (There may
- be some cross-compilation or embedded set-ups where it is needed,
- however.)
-
- If you encounter a problem in this function, it's probably a symptom
- that Configure failed to detect your system's vprintf() function.
- See the section on "item vsprintf" in the INSTALL file.
-
- This version may compile on systems with BSD-ish <stdio.h>,
- but probably won't on others.
-*/
-
-#ifdef USE_CHAR_VSPRINTF
-char *
-#else
-int
-#endif
-vsprintf(char *dest, const char *pat, void *args)
-{
- FILE fakebuf;
-
-#if defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE)
- FILE_ptr(&fakebuf) = (STDCHAR *) dest;
- FILE_cnt(&fakebuf) = 32767;
-#else
- /* These probably won't compile -- If you really need
- this, you'll have to figure out some other method. */
- fakebuf._ptr = dest;
- fakebuf._cnt = 32767;
-#endif
-#ifndef _IOSTRG
-#define _IOSTRG 0
-#endif
- fakebuf._flag = _IOWRT|_IOSTRG;
- _doprnt(pat, args, &fakebuf); /* what a kludge */
-#if defined(STDIO_PTR_LVALUE)
- *(FILE_ptr(&fakebuf)++) = '\0';
-#else
- /* PerlIO has probably #defined away fputc, but we want it here. */
-# ifdef fputc
-# undef fputc /* XXX Should really restore it later */
-# endif
- (void)fputc('\0', &fakebuf);
-#endif
-#ifdef USE_CHAR_VSPRINTF
- return(dest);
-#else
- return 0; /* perl doesn't use return value */
-#endif
-}
-
-#endif /* HAS_VPRINTF */
-
PerlIO *
Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args)
{
taint_env();
taint_proper("Insecure %s%s", "EXEC");
}
- if (PerlProc_pipe(p) < 0)
+ if (PerlProc_pipe_cloexec(p) < 0)
return NULL;
/* Try for another pipe pair for error return */
- if (PerlProc_pipe(pp) >= 0)
+ if (PerlProc_pipe_cloexec(pp) >= 0)
did_pipes = 1;
while ((pid = PerlProc_fork()) < 0) {
if (errno != EAGAIN) {
#define THIS that
#define THAT This
/* Close parent's end of error status pipe (if any) */
- if (did_pipes) {
+ if (did_pipes)
PerlLIO_close(pp[0]);
-#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC)
- /* Close error pipe automatically if exec works */
- if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0)
- return NULL;
-#endif
- }
/* Now dup our end of _the_ pipe to right position */
if (p[THIS] != (*mode == 'r')) {
PerlLIO_dup2(p[THIS], *mode == 'r');
#undef THAT
}
/* Parent */
- do_execfree(); /* free any memory malloced by child on fork */
if (did_pipes)
PerlLIO_close(pp[1]);
/* Keep the lower of the two fd numbers */
if (p[that] < p[This]) {
- PerlLIO_dup2(p[This], p[that]);
+ PerlLIO_dup2_cloexec(p[This], p[that]);
PerlLIO_close(p[This]);
p[This] = p[that];
}
if (did_pipes && pid > 0) {
int errkid;
unsigned n = 0;
- SSize_t n1;
while (n < sizeof(int)) {
- n1 = PerlLIO_read(pp[0],
+ const SSize_t n1 = PerlLIO_read(pp[0],
(void*)(((char*)&errkid)+n),
(sizeof(int)) - n);
if (n1 <= 0)
taint_env();
taint_proper("Insecure %s%s", "EXEC");
}
- if (PerlProc_pipe(p) < 0)
+ if (PerlProc_pipe_cloexec(p) < 0)
return NULL;
- if (doexec && PerlProc_pipe(pp) >= 0)
+ if (doexec && PerlProc_pipe_cloexec(pp) >= 0)
did_pipes = 1;
while ((pid = PerlProc_fork()) < 0) {
if (errno != EAGAIN) {
#undef THAT
#define THIS that
#define THAT This
- if (did_pipes) {
+ if (did_pipes)
PerlLIO_close(pp[0]);
-#if defined(HAS_FCNTL) && defined(F_SETFD)
- if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0)
- return NULL;
-#endif
- }
if (p[THIS] != (*mode == 'r')) {
PerlLIO_dup2(p[THIS], *mode == 'r');
PerlLIO_close(p[THIS]);
#undef THIS
#undef THAT
}
- do_execfree(); /* free any memory malloced by child on vfork */
if (did_pipes)
PerlLIO_close(pp[1]);
if (p[that] < p[This]) {
- PerlLIO_dup2(p[This], p[that]);
+ PerlLIO_dup2_cloexec(p[This], p[that]);
PerlLIO_close(p[This]);
p[This] = p[that];
}
if (did_pipes && pid > 0) {
int errkid;
unsigned n = 0;
- SSize_t n1;
while (n < sizeof(int)) {
- n1 = PerlLIO_read(pp[0],
+ const SSize_t n1 = PerlLIO_read(pp[0],
(void*)(((char*)&errkid)+n),
(sizeof(int)) - n);
if (n1 <= 0)
PerlLIO_close(pp[0]);
return PerlIO_fdopen(p[This], mode);
}
-#else
-#if defined(DJGPP)
+#elif defined(DJGPP)
FILE *djgpp_popen();
PerlIO *
Perl_my_popen(pTHX_ const char *cmd, const char *mode)
*/
return PerlIO_importFILE(djgpp_popen(cmd, mode), 0);
}
-#else
-#if defined(__LIBCATAMOUNT__)
+#elif defined(__LIBCATAMOUNT__)
PerlIO *
Perl_my_popen(pTHX_ const char *cmd, const char *mode)
{
return NULL;
}
-#endif
-#endif
#endif /* !DOSISH */
: 0
);
}
-#else
-#if defined(__LIBCATAMOUNT__)
+#elif defined(__LIBCATAMOUNT__)
I32
Perl_my_pclose(pTHX_ PerlIO *ptr)
{
return -1;
}
-#endif
#endif /* !DOSISH */
#if (!defined(DOSISH) || defined(OS2) || defined(WIN32) || defined(NETWARE)) && !defined(__LIBCATAMOUNT__)
if (len < sizeof tmpbuf)
tmpbuf[len] = '\0';
# else
- s = delimcpy(tmpbuf, tmpbuf + sizeof tmpbuf, s, bufend,
- ':',
- &len);
+ s = delimcpy_no_escape(tmpbuf, tmpbuf + sizeof tmpbuf, s, bufend,
+ ':', &len);
# endif
if (s < bufend)
s++;
if (error)
Perl_croak_nocontext("panic: pthread_getspecific, error=%d", error);
return (void*)t;
-# else
-# ifdef I_MACH_CTHREADS
+# elif defined(I_MACH_CTHREADS)
return (void*)cthread_data(cthread_self());
-# else
+# else
return (void*)PTHREAD_GETSPECIFIC(PL_thr_key);
-# endif
# endif
#else
return (void*)NULL;
long open_max = -1;
# ifdef PERL_FFLUSH_ALL_FOPEN_MAX
open_max = PERL_FFLUSH_ALL_FOPEN_MAX;
-# else
-# if defined(HAS_SYSCONF) && defined(_SC_OPEN_MAX)
+# elif defined(HAS_SYSCONF) && defined(_SC_OPEN_MAX)
open_max = sysconf(_SC_OPEN_MAX);
-# else
-# ifdef FOPEN_MAX
+# elif defined(FOPEN_MAX)
open_max = FOPEN_MAX;
-# else
-# ifdef OPEN_MAX
+# elif defined(OPEN_MAX)
open_max = OPEN_MAX;
-# else
-# ifdef _NFILE
+# elif defined(_NFILE)
open_max = _NFILE;
-# endif
-# endif
-# endif
-# endif
-# endif
+# endif
if (open_max > 0) {
long i;
for (i = 0; i < open_max; i++)
* This algorithm also fails to handle years before A.D. 1 gracefully, but
* that's still outside the scope for POSIX time manipulation, so I don't
* care.
+ *
+ * - lwall
*/
year = 1900 + ptm->tm_year;
{
#ifdef HAS_STRFTIME
- /* Note that yday and wday effectively are ignored by this function, as mini_mktime() overwrites them */
+ /* strftime(), but with a different API so that the return value is a pointer
+ * to the formatted result (which MUST be arranged to be FREED BY THE
+ * CALLER). This allows this function to increase the buffer size as needed,
+ * so that the caller doesn't have to worry about that.
+ *
+ * Note that yday and wday effectively are ignored by this function, as
+ * mini_mktime() overwrites them */
char *buf;
int buflen;
buflen = 64;
Newx(buf, buflen, char);
- GCC_DIAG_IGNORE(-Wformat-nonliteral); /* fmt checked by caller */
+ GCC_DIAG_IGNORE_STMT(-Wformat-nonliteral); /* fmt checked by caller */
len = strftime(buf, buflen, fmt, &mytm);
- GCC_DIAG_RESTORE;
+ GCC_DIAG_RESTORE_STMT;
/*
** The following is needed to handle to the situation where
Renew(buf, bufsize, char);
while (buf) {
- GCC_DIAG_IGNORE(-Wformat-nonliteral); /* fmt checked by caller */
+ GCC_DIAG_IGNORE_STMT(-Wformat-nonliteral); /* fmt checked by caller */
buflen = strftime(buf, bufsize, fmt, &mytm);
- GCC_DIAG_RESTORE;
+ GCC_DIAG_RESTORE_STMT;
if (buflen > 0 && buflen < bufsize)
break;
return -1;
}
+#ifdef SOCK_CLOEXEC
+ type &= ~SOCK_CLOEXEC;
+#endif
+
#ifdef EMULATE_SOCKETPAIR_UDP
if (type == SOCK_DGRAM)
return S_socketpair_udp(fd);
abort_tidy_up_and_fail:
#ifdef ECONNABORTED
errno = ECONNABORTED; /* This would be the standard thing to do. */
-#else
-# ifdef ECONNREFUSED
+#elif defined(ECONNREFUSED)
errno = ECONNREFUSED; /* E.g. Symbian does not have ECONNABORTED. */
-# else
+#else
errno = ETIMEDOUT; /* Desperation time. */
-# endif
#endif
tidy_up_and_fail:
{
# define PERL_RANDOM_DEVICE "/dev/urandom"
# endif
#endif
- fd = PerlLIO_open(PERL_RANDOM_DEVICE, 0);
+ fd = PerlLIO_open_cloexec(PERL_RANDOM_DEVICE, 0);
if (fd != -1) {
if (PerlLIO_read(fd, (void*)&u, sizeof u) != sizeof u)
u = 0;
void
Perl_get_hash_seed(pTHX_ unsigned char * const seed_buffer)
{
+#ifndef NO_PERL_HASH_ENV
const char *env_pv;
+#endif
unsigned long i;
PERL_ARGS_ASSERT_GET_HASH_SEED;
+#ifndef NO_PERL_HASH_ENV
env_pv= PerlEnv_getenv("PERL_HASH_SEED");
if ( env_pv )
-#ifndef USE_HASH_SEED_EXPLICIT
{
/* ignore leading spaces */
while (isSPACE(*env_pv))
env_pv++;
-#ifdef USE_PERL_PERTURB_KEYS
+# ifdef USE_PERL_PERTURB_KEYS
/* if they set it to "0" we disable key traversal randomization completely */
if (strEQ(env_pv,"0")) {
PL_hash_rand_bits_enabled= 0;
/* otherwise switch to deterministic mode */
PL_hash_rand_bits_enabled= 2;
}
-#endif
+# endif
/* ignore a leading 0x... if it is there */
if (env_pv[0] == '0' && env_pv[1] == 'x')
env_pv += 2;
/* should we warn about insufficient hex? */
}
else
-#endif
+#endif /* NO_PERL_HASH_ENV */
{
- (void)seedDrand01((Rand_seed_t)seed());
-
for( i = 0; i < PERL_HASH_SEED_BYTES; i++ ) {
- seed_buffer[i] = (unsigned char)(Drand01() * (U8_MAX+1));
+ seed_buffer[i] = (unsigned char)(Perl_internal_drand48() * (U8_MAX+1));
}
}
#ifdef USE_PERL_PERTURB_KEYS
PL_hash_rand_bits = ROTL_UV(PL_hash_rand_bits,8);
}
}
+# ifndef NO_PERL_HASH_ENV
env_pv= PerlEnv_getenv("PERL_PERTURB_KEYS");
if (env_pv) {
if (strEQ(env_pv,"0") || strEQ(env_pv,"NO")) {
Perl_warn(aTHX_ "perl: warning: strange setting in '$ENV{PERL_PERTURB_KEYS}': '%s'\n", env_pv);
}
}
+# endif
#endif
}
#endif /* PERL_MEM_LOG */
/*
-=for apidoc my_sprintf
-
-The C library C<sprintf>, wrapped if necessary, to ensure that it will return
-the length of the string written to the buffer. Only rare pre-ANSI systems
-need the wrapper function - usually this is a direct call to C<sprintf>.
-
-=cut
-*/
-#ifndef SPRINTF_RETURNS_STRLEN
-int
-Perl_my_sprintf(char *buffer, const char* pat, ...)
-{
- va_list args;
- PERL_ARGS_ASSERT_MY_SPRINTF;
- va_start(args, pat);
- vsprintf(buffer, pat, args);
- va_end(args);
- return strlen(buffer);
-}
-#endif
-
-/*
=for apidoc quadmath_format_single
C<quadmath_snprintf()> is very strict about its C<format> string and will
if (qfmt) {
/* If the format looked promising, use it as quadmath. */
retval = quadmath_snprintf(buffer, len, qfmt, va_arg(ap, NV));
- if (retval == -1)
+ if (retval == -1) {
+ if (qfmt != format) {
+ dTHX;
+ SAVEFREEPV(qfmt);
+ }
Perl_croak_nocontext("panic: quadmath_snprintf failed, format \"%s\"", qfmt);
+ }
quadmath_valid = TRUE;
if (qfmt != format)
Safefree(qfmt);
#ifdef HAS_VSNPRINTF
/* vsnprintf() shows failure with >= len */
||
- (len > 0 && (Size_t)retval >= len)
+ (len > 0 && (Size_t)retval >= len)
#endif
)
Perl_croak_nocontext("panic: my_snprintf buffer overflow");
#ifdef HAS_VSNPRINTF
/* vsnprintf() shows failure with >= len */
||
- (len > 0 && (Size_t)retval >= len)
+ (len > 0 && (Size_t)retval >= len)
#endif
)
Perl_croak_nocontext("panic: my_vsnprintf buffer overflow");
PERL_ARGS_ASSERT_MY_CXT_INIT;
if (*index == -1) {
/* this module hasn't been allocated an index yet */
-#if defined(USE_ITHREADS)
MUTEX_LOCK(&PL_my_ctx_mutex);
-#endif
*index = PL_my_cxt_index++;
-#if defined(USE_ITHREADS)
MUTEX_UNLOCK(&PL_my_ctx_mutex);
-#endif
}
/* make sure the array is big enough */
if (PL_my_cxt_size <= *index) {
if (PL_my_cxt_size) {
- while (PL_my_cxt_size <= *index)
- PL_my_cxt_size *= 2;
- Renew(PL_my_cxt_list, PL_my_cxt_size, void *);
+ IV new_size = PL_my_cxt_size;
+ while (new_size <= *index)
+ new_size *= 2;
+ Renew(PL_my_cxt_list, new_size, void *);
+ PL_my_cxt_size = new_size;
}
else {
PL_my_cxt_size = 16;
index = Perl_my_cxt_index(aTHX_ my_cxt_key);
if (index == -1) {
/* this module hasn't been allocated an index yet */
-#if defined(USE_ITHREADS)
MUTEX_LOCK(&PL_my_ctx_mutex);
-#endif
index = PL_my_cxt_index++;
-#if defined(USE_ITHREADS)
MUTEX_UNLOCK(&PL_my_ctx_mutex);
-#endif
}
/* make sure the array is big enough */
int old_size = PL_my_cxt_size;
int i;
if (PL_my_cxt_size) {
- while (PL_my_cxt_size <= index)
- PL_my_cxt_size *= 2;
- Renew(PL_my_cxt_list, PL_my_cxt_size, void *);
- Renew(PL_my_cxt_keys, PL_my_cxt_size, const char *);
+ IV new_size = PL_my_cxt_size;
+ while (new_size <= index)
+ new_size *= 2;
+ Renew(PL_my_cxt_list, new_size, void *);
+ Renew(PL_my_cxt_keys, new_size, const char *);
+ PL_my_cxt_size = new_size;
}
else {
PL_my_cxt_size = 16;
}
#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. */
#endif
}
+#if !defined(HAS_MKOSTEMP) || !defined(HAS_MKSTEMP)
+
+#define TEMP_FILE_CH "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvxyz0123456789"
+#define TEMP_FILE_CH_COUNT (sizeof(TEMP_FILE_CH)-1)
+
+static int
+S_my_mkostemp(char *templte, int flags) {
+ dTHX;
+ STRLEN len = strlen(templte);
+ int fd;
+ int attempts = 0;
+
+ if (len < 6 ||
+ templte[len-1] != 'X' || templte[len-2] != 'X' || templte[len-3] != 'X' ||
+ templte[len-4] != 'X' || templte[len-5] != 'X' || templte[len-6] != 'X') {
+ SETERRNO(EINVAL, LIB_INVARG);
+ return -1;
+ }
+
+ do {
+ int i;
+ for (i = 1; i <= 6; ++i) {
+ templte[len-i] = TEMP_FILE_CH[(int)(Perl_internal_drand48() * TEMP_FILE_CH_COUNT)];
+ }
+ fd = PerlLIO_open3(templte, O_RDWR | O_CREAT | O_EXCL | flags, 0600);
+ } while (fd == -1 && errno == EEXIST && ++attempts <= 100);
+
+ return fd;
+}
+
+#endif
+
+#ifndef HAS_MKOSTEMP
+int
+Perl_my_mkostemp(char *templte, int flags)
+{
+ PERL_ARGS_ASSERT_MY_MKOSTEMP;
+ return S_my_mkostemp(templte, flags);
+}
+#endif
+
+#ifndef HAS_MKSTEMP
+int
+Perl_my_mkstemp(char *templte)
+{
+ PERL_ARGS_ASSERT_MY_MKSTEMP;
+ return S_my_mkostemp(templte, 0);
+}
+#endif
+
REGEXP *
Perl_get_re_arg(pTHX_ SV *sv) {
#ifdef PERL_DRAND48_QUAD
-#define DRAND48_MULT U64_CONST(0x5deece66d)
+#define DRAND48_MULT UINT64_C(0x5deece66d)
#define DRAND48_ADD 0xb
-#define DRAND48_MASK U64_CONST(0xffffffffffff)
+#define DRAND48_MASK UINT64_C(0xffffffffffff)
#else
UV uv;
/* Skip trailing whitespace. */
- while (p > start && isspace(*p)) p--;
+ while (p > start && isSPACE(*p)) p--;
/* Now we should be at the close paren. */
if (p == start || *p != ')')
return NULL;
close_paren = p;
p--;
/* Now we should be in the line number. */
- if (p == start || !isdigit(*p))
+ if (p == start || !isDIGIT(*p))
return NULL;
/* Skip over the digits. */
- while (p > start && isdigit(*p))
+ while (p > start && isDIGIT(*p))
p--;
/* Now we should be at the colon. */
if (p == start || *p != ':')
* the object name (used as "-o '%s'" ), leave since at least
* partially the user controls it. */
for (p = ctx->fname; *p; p++) {
- if (*p == '\'' || iscntrl(*p)) {
+ if (*p == '\'' || isCNTRL(*p)) {
ctx->unavail = TRUE;
return;
}
sv_catpvs(dsv, "\n");
}
- Perl_free_c_backtrace(aTHX_ bt);
+ Perl_free_c_backtrace(bt);
return dsv;
}
https://perl5.git.perl.org / perl5.git / blobdiff