# include <sys/resource.h>
#endif
+/* Cygwin's stdio.h doesn't make cuserid() visible with -D_GNU_SOURCE,
+ unlike Linux.
+*/
+#ifdef __CYGWIN__
+# undef HAS_CUSERID
+#endif
+
#if defined(USE_QUADMATH) && defined(I_QUADMATH)
# undef M_E
# undef c99_trunc
#endif
+/* The cc with NetBSD 8.0 and 9.0 claims to be a C11 hosted compiler,
+ * but doesn't define several functions required by C99, let alone C11.
+ * http://gnats.netbsd.org/53234
+ */
+#if defined(USE_LONG_DOUBLE) && defined(__NetBSD__) \
+ && !defined(NETBSD_HAVE_FIXED_LONG_DOUBLE_MATH)
+# undef c99_expm1
+# undef c99_lgamma
+# undef c99_log1p
+# undef c99_log2
+# undef c99_nexttoward
+# undef c99_remainder
+# undef c99_remquo
+# undef c99_tgamma
+#endif
+
#ifndef isunordered
# ifdef Perl_isnan
# define isunordered(x, y) (Perl_isnan(x) || Perl_isnan(y))
# undef c99_trunc
#endif
-#ifdef WIN32
+#ifdef _MSC_VER
/* Some APIs exist under Win32 with "underbar" names. */
# undef c99_hypot
}
#endif
not_here("rint");
+ NOT_REACHED; /* NOTREACHED */
}
#endif
#ifdef NV_PAYLOAD_DEBUG
Perl_warn(aTHX_ "a[%d] = %" UVxf "\n", i, a[i]);
#endif
- payload *= UV_MAX;
+ payload *= (NV) UV_MAX;
payload += a[i];
}
#ifdef NV_PAYLOAD_DEBUG
#define waitpid(a,b,c) not_here("waitpid")
#endif
-#ifndef HAS_MBLEN
-#ifndef mblen
-#define mblen(a,b) not_here("mblen")
+#if ! defined(HAS_MBLEN) && ! defined(HAS_MBRLEN)
+# define mblen(a,b) not_here("mblen")
#endif
+#if ! defined(HAS_MBTOWC) && ! defined(HAS_MBRTOWC)
+# define mbtowc(pwc, s, n) not_here("mbtowc")
#endif
-#ifndef HAS_MBSTOWCS
-#define mbstowcs(s, pwcs, n) not_here("mbstowcs")
-#endif
-#ifndef HAS_MBTOWC
-#define mbtowc(pwc, s, n) not_here("mbtowc")
-#endif
-#ifndef HAS_WCSTOMBS
-#define wcstombs(s, pwcs, n) not_here("wcstombs")
-#endif
-#ifndef HAS_WCTOMB
-#define wctomb(s, wchar) not_here("wcstombs")
+#if ! defined(HAS_WCTOMB) && ! defined(HAS_WCRTOMB)
+# define wctomb(s, wchar) not_here("wctomb")
#endif
#if !defined(HAS_MBLEN) && !defined(HAS_MBSTOWCS) && !defined(HAS_MBTOWC) && !defined(HAS_WCSTOMBS) && !defined(HAS_WCTOMB)
/* If we don't have these functions, then we wouldn't have gotten a typedef
#endif
#endif
-#ifndef HAS_LOCALECONV
+#if ! defined(HAS_LOCALECONV) && ! defined(HAS_LOCALECONV_L)
# define localeconv() not_here("localeconv")
#else
struct lconv_offset {
* "write through" environment changes to the process environment.
*
* (c) Even the primary Perl interpreter won't update the CRT copy of the
- * the environment, only the Win32API copy (it calls win32_putenv()).
+ * environment, only the Win32API copy (it calls win32_putenv()).
*
* As with CPerlHost::Getenv() and CPerlHost::Putenv() themselves, it makes
* sense to only update the process environment when inside the main
sizeof(sigset_t),
packname);
sigemptyset(s);
- for (i = 1; i < items; i++)
- sigaddset(s, SvIV(ST(i)));
+ for (i = 1; i < items; i++) {
+ IV sig = SvIV(ST(i));
+ if (sigaddset(s, sig) < 0)
+ croak("POSIX::Sigset->new: failed to add signal %" IVdf, sig);
+ }
XSRETURN(1);
}
lcbuf = localeconv_l(cur);
# else
- LOCALE_LOCK_V; /* Prevent interference with other threads using
- localeconv() */
+ LOCALECONV_LOCK; /* Prevent interference with other threads using
+ localeconv() */
# ifdef TS_W32_BROKEN_LOCALECONV
/* This is a workaround for a Windows bug prior to VS 15, in which
* localeconv only looks at the global locale. We toggle to the global
Safefree(save_global);
Safefree(save_thread);
# endif
- LOCALE_UNLOCK_V;
+ LOCALECONV_UNLOCK;
# endif
RESTORE_LC_NUMERIC();
#endif /* HAS_LOCALECONV */
#endif
break;
case 17:
- RETVAL = log10(x); /* C89 math */
+ RETVAL = Perl_log10(x); /* C89 math */
break;
case 18:
#ifdef c99_log1p
ldexp(x,exp)
NV x
int exp
+ CODE:
+ RETVAL = Perl_ldexp(x, exp);
+ OUTPUT:
+ RETVAL
void
modf(x)
# interface look beautiful, which is hard.
{
- dVAR;
POSIX__SigAction action;
GV *siggv = gv_fetchpvs("SIG", GV_ADD, SVt_PVHV);
struct sigaction act;
/* Remember old disposition if desired. */
if (oldaction) {
+ int safe;
+
svp = hv_fetchs(oldaction, "HANDLER", TRUE);
if(!svp)
croak("Can't supply an oldaction without a HANDLER");
svp = hv_fetchs(oldaction, "FLAGS", TRUE);
sv_setiv(*svp, oact.sa_flags);
- /* Get back whether the old handler used safe signals. */
+ /* Get back whether the old handler used safe signals;
+ * i.e. it used Perl_csighandler[13] rather than
+ * Perl_sighandler[13]
+ */
+ safe =
+#ifdef SA_SIGINFO
+ (oact.sa_flags & SA_SIGINFO)
+ ? ( oact.sa_sigaction == PL_csighandler3p
+#ifdef PERL_USE_3ARG_SIGHANDLER
+ || oact.sa_sigaction == PL_csighandlerp
+#endif
+ )
+ :
+#endif
+ ( oact.sa_handler == PL_csighandler1p
+#ifndef PERL_USE_3ARG_SIGHANDLER
+ || oact.sa_handler == PL_csighandlerp
+#endif
+ );
+
svp = hv_fetchs(oldaction, "SAFE", TRUE);
- sv_setiv(*svp,
- /* compare incompatible pointers by casting to integer */
- PTR2nat(oact.sa_handler) == PTR2nat(PL_csighandlerp));
+ sv_setiv(*svp, safe);
}
if (action) {
+ int safe;
+
+ /* Set up any desired flags. */
+ svp = hv_fetchs(action, "FLAGS", FALSE);
+ act.sa_flags = svp ? SvIV(*svp) : 0;
+
/* Safe signals use "csighandler", which vectors through the
PL_sighandlerp pointer when it's safe to do so.
(BTW, "csighandler" is very different from "sighandler".) */
svp = hv_fetchs(action, "SAFE", FALSE);
- act.sa_handler =
- DPTR2FPTR(
- void (*)(int),
- (*svp && SvTRUE(*svp))
- ? PL_csighandlerp : PL_sighandlerp
- );
+ safe = *svp && SvTRUE(*svp);
+#ifdef SA_SIGINFO
+ if (act.sa_flags & SA_SIGINFO) {
+ /* 3-arg handler */
+ act.sa_sigaction =
+ safe ? PL_csighandler3p : PL_sighandler3p;
+ }
+ else
+#endif
+ {
+ /* 1-arg handler */
+ act.sa_handler =
+ safe ? PL_csighandler1p : PL_sighandler1p;
+ }
/* Vector new Perl handler through %SIG.
(The core signal handlers read %SIG to dispatch.) */
else
sigemptyset(& act.sa_mask);
- /* Set up any desired flags. */
- svp = hv_fetchs(action, "FLAGS", FALSE);
- act.sa_flags = svp ? SvIV(*svp) : 0;
-
/* Don't worry about cleaning up *sigsvp if this fails,
* because that means we tried to disposition a
* nonblockable signal, in which case *sigsvp is
void
abort()
-#ifdef I_WCHAR
-# include <wchar.h>
+#if defined(HAS_MBRLEN) && (defined(USE_ITHREADS) || ! defined(HAS_MBLEN))
+# define USE_MBRLEN
+#else
+# undef USE_MBRLEN
#endif
int
-mblen(s, n)
- char * s
+mblen(s, n = ~0)
+ SV * s
size_t n
- PREINIT:
-#if defined(USE_ITHREADS) && defined(HAS_MBRLEN)
- mbstate_t ps;
-#endif
CODE:
-#if defined(USE_ITHREADS) && defined(HAS_MBRLEN)
- PERL_UNUSED_RESULT(mbrlen(NULL, 0, &ps)); /* Initialize state */
- RETVAL = mbrlen(s, n, &ps); /* Prefer reentrant version */
+ errno = 0;
+
+ SvGETMAGIC(s);
+ if (! SvOK(s)) {
+#ifdef USE_MBRLEN
+ /* Initialize the shift state in PL_mbrlen_ps. The Standard says
+ * that should be all zeros. */
+ memzero(&PL_mbrlen_ps, sizeof(PL_mbrlen_ps));
+ RETVAL = 0;
#else
- RETVAL = mblen(s, n);
+ LOCALE_LOCK;
+ RETVAL = mblen(NULL, 0);
+ LOCALE_UNLOCK;
+#endif
+ }
+ else { /* Not resetting state */
+ SV * byte_s = sv_2mortal(newSVsv_nomg(s));
+ if (! sv_utf8_downgrade_nomg(byte_s, TRUE)) {
+ SETERRNO(EINVAL, LIB_INVARG);
+ RETVAL = -1;
+ }
+ else {
+ size_t len;
+ char * string = SvPV(byte_s, len);
+ if (n < len) len = n;
+#ifdef USE_MBRLEN
+ RETVAL = (SSize_t) mbrlen(string, len, &PL_mbrlen_ps);
+ if (RETVAL < 0) RETVAL = -1; /* Use mblen() ret code for
+ transparency */
+#else
+ /* Locking prevents races, but locales can be switched out
+ * without locking, so this isn't a cure all */
+ LOCALE_LOCK;
+ RETVAL = mblen(string, len);
+ LOCALE_UNLOCK;
#endif
+ }
+ }
OUTPUT:
RETVAL
-size_t
-mbstowcs(s, pwcs, n)
- wchar_t * s
- char * pwcs
- size_t n
+#if defined(HAS_MBRTOWC) && (defined(USE_ITHREADS) || ! defined(HAS_MBTOWC))
+# define USE_MBRTOWC
+#else
+# undef USE_MBRTOWC
+#endif
int
-mbtowc(pwc, s, n)
- wchar_t * pwc
- char * s
+mbtowc(pwc, s, n = ~0)
+ SV * pwc
+ SV * s
size_t n
- PREINIT:
-#if defined(USE_ITHREADS) && defined(HAS_MBRTOWC)
- mbstate_t ps;
-#endif
CODE:
-#if defined(USE_ITHREADS) && defined(HAS_MBRTOWC)
- memset(&ps, 0, sizeof(ps));;
- PERL_UNUSED_RESULT(mbrtowc(pwc, NULL, 0, &ps));/* Reset any shift state */
errno = 0;
- RETVAL = mbrtowc(pwc, s, n, &ps); /* Prefer reentrant version */
+ SvGETMAGIC(s);
+ if (! SvOK(s)) { /* Initialize state */
+#ifdef USE_MBRTOWC
+ /* Initialize the shift state to all zeros in PL_mbrtowc_ps. */
+ memzero(&PL_mbrtowc_ps, sizeof(PL_mbrtowc_ps));
+ RETVAL = 0;
#else
- RETVAL = mbtowc(pwc, s, n);
+ LOCALE_LOCK;
+ RETVAL = mbtowc(NULL, NULL, 0);
+ LOCALE_UNLOCK;
#endif
+ }
+ else { /* Not resetting state */
+ wchar_t wc;
+ SV * byte_s = sv_2mortal(newSVsv_nomg(s));
+ if (! sv_utf8_downgrade_nomg(byte_s, TRUE)) {
+ SETERRNO(EINVAL, LIB_INVARG);
+ RETVAL = -1;
+ }
+ else {
+ size_t len;
+ char * string = SvPV(byte_s, len);
+ if (n < len) len = n;
+#ifdef USE_MBRTOWC
+ RETVAL = (SSize_t) mbrtowc(&wc, string, len, &PL_mbrtowc_ps);
+#else
+ /* Locking prevents races, but locales can be switched out
+ * without locking, so this isn't a cure all */
+ LOCALE_LOCK;
+ RETVAL = mbtowc(&wc, string, len);
+ LOCALE_UNLOCK;
+#endif
+ if (RETVAL >= 0) {
+ sv_setiv_mg(pwc, wc);
+ }
+ else { /* Use mbtowc() ret code for transparency */
+ RETVAL = -1;
+ }
+ }
+ }
OUTPUT:
RETVAL
-int
-wcstombs(s, pwcs, n)
- char * s
- wchar_t * pwcs
- size_t n
+#if defined(HAS_WCRTOMB) && (defined(USE_ITHREADS) || ! defined(HAS_WCTOMB))
+# define USE_WCRTOMB
+#else
+# undef USE_WCRTOMB
+#endif
int
wctomb(s, wchar)
- char * s
+ SV * s
wchar_t wchar
+ CODE:
+ errno = 0;
+ SvGETMAGIC(s);
+ if (s == &PL_sv_undef) {
+#ifdef USE_WCRTOMB
+ /* The man pages khw looked at are in agreement that this works.
+ * But probably memzero would too */
+ RETVAL = wcrtomb(NULL, L'\0', &PL_wcrtomb_ps);
+#else
+ LOCALE_LOCK;
+ RETVAL = wctomb(NULL, L'\0');
+ LOCALE_UNLOCK;
+#endif
+ }
+ else { /* Not resetting state */
+ char buffer[MB_LEN_MAX];
+#ifdef USE_WCRTOMB
+ RETVAL = wcrtomb(buffer, wchar, &PL_wcrtomb_ps);
+#else
+ /* Locking prevents races, but locales can be switched out without
+ * locking, so this isn't a cure all */
+ LOCALE_LOCK;
+ RETVAL = wctomb(buffer, wchar);
+ LOCALE_UNLOCK;
+#endif
+ if (RETVAL >= 0) {
+ sv_setpvn_mg(s, buffer, RETVAL);
+ }
+ }
+ OUTPUT:
+ RETVAL
int
strcoll(s1, s2)
long num;
char *unparsed;
PPCODE:
- if (base == 0 || (base >= 2 && base <= 36)) {
+ if (base == 0 || inRANGE(base, 2, 36)) {
num = strtol(str, &unparsed, base);
#if IVSIZE < LONGSIZE
if (num < IV_MIN || num > IV_MAX)
PPCODE:
PERL_UNUSED_VAR(str);
PERL_UNUSED_VAR(base);
- if (base == 0 || (base >= 2 && base <= 36)) {
+ if (base == 0 || inRANGE(base, 2, 36)) {
num = strtoul(str, &unparsed, base);
#if IVSIZE <= LONGSIZE
if (num > IV_MAX)
#else /* If can't check directly, at least can see if script is consistent,
under UTF-8, which gives us an extra measure of confidence. */
- && isSCRIPT_RUN((const U8 *) buf, buf + len,
+ && isSCRIPT_RUN((const U8 *) buf,
+ (const U8 *) buf + len,
TRUE) /* Means assume UTF-8 */
#endif
)) {
ctermid(s = 0)
char * s = 0;
CODE:
-#ifdef HAS_CTERMID_R
+#ifdef I_TERMIOS
+ /* On some systems L_ctermid is a #define; but not all; this code works
+ * for all cases (so far...) */
s = (char *) safemalloc((size_t) L_ctermid);
#endif
RETVAL = ctermid(s);
OUTPUT:
RETVAL
CLEANUP:
-#ifdef HAS_CTERMID_R
+#ifdef I_TERMIOS
Safefree(s);
#endif
https://perl5.git.perl.org / perl5.git / blobdiff