This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Revert "Revert "infnan: more tests.""
[perl5.git] / perl.h
diff --git a/perl.h b/perl.h
index 6a1433d..5615b96 100644 (file)
--- a/perl.h
+++ b/perl.h
 #   include "config.h"
 #endif
 
-#if (defined(__STDC_VERSION__) && __STDC_VERSION__ >= 199901L) || defined(_STDC_C99)
+/* NOTE 1: that with gcc -std=c89 the __STDC_VERSION__ is *not* defined
+ * because the __STDC_VERSION__ became a thing only with C90.  Therefore,
+ * with gcc, HAS_C99 will never become true as long as we use -std=c89.
+
+ * NOTE 2: headers lie.  Do not expect that if HAS_C99 gets to be true,
+ * all the C99 features are there and are correct. */
+#if (defined(__STDC_VERSION__) && __STDC_VERSION__ >= 199901L) || \
+     defined(_STDC_C99)
 #  define HAS_C99 1
 #endif
 
@@ -1555,6 +1562,10 @@ EXTERN_C char *crypt(const char *, const char *);
 
 #define PERL_SNPRINTF_CHECK(len, max, api) STMT_START { if ((max) > 0 && (Size_t)len >= (max)) Perl_croak_nocontext("panic: %s buffer overflow", STRINGIFY(api)); } STMT_END
 
+#ifdef USE_QUADMATH
+#  define my_snprintf Perl_my_snprintf
+#  define PERL_MY_SNPRINTF_GUARDED
+#else
 #if defined(HAS_SNPRINTF) && defined(HAS_C99_VARIADIC_MACROS) && !(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS)) && !defined(PERL_GCC_PEDANTIC)
 #  ifdef PERL_USE_GCC_BRACE_GROUPS
 #      define my_snprintf(buffer, max, ...) ({ int len = snprintf(buffer, max, __VA_ARGS__); PERL_SNPRINTF_CHECK(len, max, snprintf); len; })
@@ -1566,7 +1577,10 @@ EXTERN_C char *crypt(const char *, const char *);
 #  define my_snprintf  Perl_my_snprintf
 #  define PERL_MY_SNPRINTF_GUARDED
 #endif
+#endif
 
+/* There is no quadmath_vsnprintf, and therefore my_vsnprintf()
+ * dies if called under USE_QUADMATH. */
 #if defined(HAS_VSNPRINTF) && defined(HAS_C99_VARIADIC_MACROS) && !(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS)) && !defined(PERL_GCC_PEDANTIC)
 #  ifdef PERL_USE_GCC_BRACE_GROUPS
 #      define my_vsnprintf(buffer, max, ...) ({ int len = vsnprintf(buffer, max, __VA_ARGS__); PERL_SNPRINTF_CHECK(len, max, vsnprintf); len; })
@@ -1847,45 +1861,83 @@ typedef NVTYPE NV;
 #   ifdef I_SUNMATH
 #       include <sunmath.h>
 #   endif
-#   define NV_DIG LDBL_DIG
-#   ifdef LDBL_MANT_DIG
-#       define NV_MANT_DIG LDBL_MANT_DIG
-#   endif
-#   ifdef LDBL_MIN
-#       define NV_MIN LDBL_MIN
-#   endif
-#   ifdef LDBL_MAX
-#       define NV_MAX LDBL_MAX
-#   endif
-#   ifdef LDBL_MIN_EXP
-#       define NV_MIN_EXP LDBL_MIN_EXP
-#   endif
-#   ifdef LDBL_MAX_EXP
-#       define NV_MAX_EXP LDBL_MAX_EXP
-#   endif
-#   ifdef LDBL_MIN_10_EXP
-#       define NV_MIN_10_EXP LDBL_MIN_10_EXP
-#   endif
-#   ifdef LDBL_MAX_10_EXP
-#       define NV_MAX_10_EXP LDBL_MAX_10_EXP
-#   endif
-#   ifdef LDBL_EPSILON
-#       define NV_EPSILON LDBL_EPSILON
+#   if defined(USE_QUADMATH) && defined(I_QUADMATH)
+#       include <quadmath.h>
 #   endif
-#   ifdef LDBL_MAX
-#       define NV_MAX LDBL_MAX
+#   ifdef FLT128_DIG
+#       define NV_DIG FLT128_DIG
+#       define NV_MANT_DIG FLT128_MANT_DIG
+#       define NV_MIN FLT128_MIN
+#       define NV_MAX FLT128_MAX
+#       define NV_MIN_EXP FLT128_MIN_EXP
+#       define NV_MAX_EXP FLT128_MAX_EXP
+#       define NV_EPSILON FLT128_EPSILON
+#       define NV_MIN_10_EXP FLT128_MIN_10_EXP
+#       define NV_MAX_10_EXP FLT128_MAX_10_EXP
+#       define NV_INF HUGE_VALQ
+#       define NV_NAN nanq("0")
+#   elif defined(LDBL_DIG)
+#       define NV_DIG LDBL_DIG
+#       ifdef LDBL_MANT_DIG
+#           define NV_MANT_DIG LDBL_MANT_DIG
+#       endif
+#       ifdef LDBL_MIN
+#           define NV_MIN LDBL_MIN
+#       endif
+#       ifdef LDBL_MAX
+#           define NV_MAX LDBL_MAX
+#       endif
+#       ifdef LDBL_MIN_EXP
+#           define NV_MIN_EXP LDBL_MIN_EXP
+#       endif
+#       ifdef LDBL_MAX_EXP
+#           define NV_MAX_EXP LDBL_MAX_EXP
+#       endif
+#       ifdef LDBL_MIN_10_EXP
+#           define NV_MIN_10_EXP LDBL_MIN_10_EXP
+#       endif
+#       ifdef LDBL_MAX_10_EXP
+#           define NV_MAX_10_EXP LDBL_MAX_10_EXP
+#       endif
+#       ifdef LDBL_EPSILON
+#           define NV_EPSILON LDBL_EPSILON
+#       endif
+#       ifdef LDBL_MAX
+#           define NV_MAX LDBL_MAX
 /* Having LDBL_MAX doesn't necessarily mean that we have LDBL_MIN... -Allen */
-#   else
-#       ifdef HUGE_VALL
-#           define NV_MAX HUGE_VALL
 #       else
-#           ifdef HUGE_VAL
-#               define NV_MAX ((NV)HUGE_VAL)
+#           ifdef HUGE_VALL
+#               define NV_MAX HUGE_VALL
 #           endif
 #       endif
 #   endif
-#   ifdef HAS_SQRTL
-/* These math interfaces are the long double cousins of the C89 math. */
+#   if defined(USE_QUADMATH) && defined(I_QUADMATH)
+#       define Perl_acos acosq
+#       define Perl_asin asinq
+#       define Perl_atan atanq
+#       define Perl_atan2 atan2q
+#       define Perl_ceil ceilq
+#       define Perl_cos cosq
+#       define Perl_cosh coshq
+#       define Perl_exp expq
+/* no Perl_fabs, but there's PERL_ABS */
+#       define Perl_floor floorq
+#       define Perl_fmod fmodq
+#       define Perl_log logq
+#       define Perl_log10 log10q
+#       define Perl_pow powq
+#       define Perl_sin sinq
+#       define Perl_sinh sinhq
+#       define Perl_sqrt sqrtq
+#       define Perl_tan tanq
+#       define Perl_tanh tanhq
+#       define Perl_modf(x,y) modfq(x,y)
+#       define Perl_frexp(x,y) frexpq(x,y)
+#       define Perl_ldexp(x, y) ldexpq(x,y)
+#       define Perl_isinf(x) isinfq(x)
+#       define Perl_isnan(x) isnanq(x)
+#       define Perl_isfinite(x) !(isnanq(x) || isinfq(x))
+#   elif defined(HAS_SQRTL)
 #       define Perl_acos acosl
 #       define Perl_asin asinl
 #       define Perl_atan atanl
@@ -1907,52 +1959,52 @@ typedef NVTYPE NV;
 #       define Perl_tanh tanhl
 #   endif
 /* e.g. libsunmath doesn't have modfl and frexpl as of mid-March 2000 */
-#   ifdef HAS_MODFL
-#       define Perl_modf(x,y) modfl(x,y)
+#   ifndef Perl_modf
+#       ifdef HAS_MODFL
+#           define Perl_modf(x,y) modfl(x,y)
 /* eg glibc 2.2 series seems to provide modfl on ppc and arm, but has no
    prototype in <math.h> */
-#       ifndef HAS_MODFL_PROTO
+#           ifndef HAS_MODFL_PROTO
 EXTERN_C long double modfl(long double, long double *);
-#      endif
-#   elif (defined(HAS_TRUNCL) || defined(HAS_AINTL)) && defined(HAS_COPYSIGNL)
+#          endif
+#       elif (defined(HAS_TRUNCL) || defined(HAS_AINTL)) && defined(HAS_COPYSIGNL)
         extern long double Perl_my_modfl(long double x, long double *ip);
 #           define Perl_modf(x,y) Perl_my_modfl(x,y)
+#       endif
 #   endif
-#   ifdef HAS_FREXPL
-#       define Perl_frexp(x,y) frexpl(x,y)
-#   else
-#       if defined(HAS_ILOGBL) && defined(HAS_SCALBNL)
-        extern long double Perl_my_frexpl(long double x, int *e);
-#           define Perl_frexp(x,y) Perl_my_frexpl(x,y)
+#   ifndef Perl_frexp
+#       ifdef HAS_FREXPL
+#           define Perl_frexp(x,y) frexpl(x,y)
+#       else
+#           if defined(HAS_ILOGBL) && defined(HAS_SCALBNL)
+extern long double Perl_my_frexpl(long double x, int *e);
+#               define Perl_frexp(x,y) Perl_my_frexpl(x,y)
+#           endif
 #       endif
 #   endif
-#   ifdef HAS_LDEXPL
-#       define Perl_ldexp(x, y) ldexpl(x,y)
-#   else
-#       if defined(HAS_SCALBNL) && FLT_RADIX == 2
-#           define Perl_ldexp(x,y) scalbnl(x,y)
+#   ifndef Perl_ldexp
+#       ifdef HAS_LDEXPL
+#           define Perl_ldexp(x, y) ldexpl(x,y)
+#       else
+#           if defined(HAS_SCALBNL) && FLT_RADIX == 2
+#               define Perl_ldexp(x,y) scalbnl(x,y)
+#           endif
 #       endif
 #   endif
 #   ifndef Perl_isnan
-#       if defined(HAS_ISNANL) && !(defined(isnan) && HAS_C99)
+#       if defined(HAS_ISNANL) && !(defined(isnan) && defined(HAS_C99))
 #           define Perl_isnan(x) isnanl(x)
 #       endif
 #   endif
 #   ifndef Perl_isinf
-#       if defined(HAS_ISINFL) && !(defined(isinf) && HAS_C99)
+#       if defined(HAS_ISINFL) && !(defined(isinf) && defined(HAS_C99))
 #           define Perl_isinf(x) isinfl(x)
 #       elif defined(LDBL_MAX)
 #           define Perl_isinf(x) ((x) > LDBL_MAX || (x) < -LDBL_MAX)
 #       endif
 #   endif
-#   if !defined(Perl_isfinite) && !(defined(isfinite) && HAS_C99)
-#     ifdef HAS_ISFINITEL
-#       define Perl_isfinite(x) isfinitel(x)
-#     elif defined(HAS_FINITEL)
-#       define Perl_isfinite(x) finitel(x)
-#     elif defined(LDBL_MAX)
-#       define Perl_isfinite(x) ((x) <= LDBL_MAX && (x) >= -LDBL_MAX)
-#     endif
+#   ifndef Perl_isfinite
+#       define Perl_isfinite(x) Perl_isfinitel(x)
 #   endif
 #else
 #   define NV_DIG DBL_DIG
@@ -2031,8 +2083,6 @@ EXTERN_C long double modfl(long double, long double *);
 #       define Perl_isfinite(x) isfinite(x)
 #     elif defined(HAS_FINITE)
 #       define Perl_isfinite(x) finite(x)
-#     elif defined(DBL_MAX)
-#       define Perl_isfinite(x) ((x) <= DBL_MAX && (x) >= -DBL_MAX)
 #     endif
 #   endif
 #endif
@@ -2289,13 +2339,15 @@ int isnan(double d);
 
 #ifndef Perl_isfinite
 #   if defined(HAS_ISFINITE) && !defined(isfinite)
-#     define Perl_isfinite(x) isfinite((double)x)
+#     define Perl_isfinite(x) isfinite((double)(x))
 #   elif defined(HAS_FINITE)
-#       define Perl_isfinite(x) finite((double)x)
+#       define Perl_isfinite(x) finite((double)(x))
 #   elif defined(Perl_fp_class_finite)
 #     define Perl_isfinite(x) Perl_fp_class_finite(x)
 #   else
-/* NaN*0 is NaN, [+-]Inf*0 is NaN, zero for anything else. */
+/* For the infinities the multiplication returns nan,
+ * for the nan the multiplication also returns nan,
+ * for everything else (that is, finite) zero should be returned. */
 #     define Perl_isfinite(x) (((x) * 0) == 0)
 #   endif
 #endif
@@ -2306,6 +2358,25 @@ int isnan(double d);
 #   endif
 #endif
 
+/* We need Perl_isfinitel (ends with ell) (if available) even when
+ * not USE_LONG_DOUBLE because the printf code (sv_catpvfn_flags)
+ * needs that. */
+#if defined(HAS_LONG_DOUBLE) && !defined(Perl_isfinitel)
+/* If isfinite() is a macro and looks like we have C99,
+ * we assume it's the type-aware C99 isfinite(). */
+#    if defined(HAS_ISFINITE) && defined(isfinite) && defined(HAS_C99)
+#        define Perl_isfinitel(x) isfinite(x)
+#    elif defined(HAS_ISFINITEL)
+#        define Perl_isfinitel(x) isfinitel(x)
+#    elif defined(HAS_FINITEL)
+#        define Perl_isfinitel(x) finitel(x)
+#    elif defined(HAS_INFL) && defined(HAS_NANL)
+#        define Perl_isfinitel(x) !(isinfl(x)||isnanl(x))
+#    else
+#        define Perl_isfinitel(x) ((x) * 0 == 0)  /* See Perl_isfinite. */
+#    endif
+#endif
+
 /* The default is to use Perl's own atof() implementation (in numeric.c).
  * Usually that is the one to use but for some platforms (e.g. UNICOS)
  * it is however best to use the native implementation of atof.
@@ -2592,6 +2663,10 @@ typedef SV PADNAME;
 # define PERL_SAWAMPERSAND
 #endif
 
+#if defined(PERL_DEBUG_READONLY_OPS) && !defined(USE_ITHREADS)
+# error PERL_DEBUG_READONLY_OPS only works with ithreads
+#endif
+
 #include "handy.h"
 
 #if defined(USE_LARGE_FILES) && !defined(NO_64_BIT_RAWIO)
@@ -4122,9 +4197,8 @@ END_EXTERN_C
 #  if !defined(NV_INF) && defined(HUGE_VAL)
 #    define NV_INF HUGE_VAL
 #  endif
-#  ifndef NV_NAN
-#    define NV_NAN (NV_INF-NV_INF)
-#  endif
+/* For WIN32 the best NV_NAN is the __PL_nan_u trick, see below.
+ * There is no supported way of getting the NAN across all the crts. */
 #endif
 
 /* If you are thinking of using HUGE_VAL for infinity, or using
@@ -4221,6 +4295,9 @@ static const union { unsigned int __i; float __f; } __PL_nan_u =
 #if !defined(NV_NAN)
 #  define NV_NAN ((NV)0.0/0.0) /* Some compilers will warn. */
 #endif
+/* Do NOT try doing NV_NAN based on NV_INF and trying (NV_INF-NV_INF).
+ * Though IEEE-754-logically correct, some compilers (like Visual C 2003)
+ * falsely misoptimize that to zero (x-x is zero, right?) */
 
 #ifndef __cplusplus
 #  if !defined(WIN32) && !defined(VMS)
@@ -4971,6 +5048,9 @@ EXTCONST char PL_bincompat_options[] =
 #  ifdef USE_PERLIO
                             " USE_PERLIO"
 #  endif
+#  ifdef USE_QUADMATH
+                            " USE_QUADMATH"
+#  endif
 #  ifdef USE_REENTRANT_API
                             " USE_REENTRANT_API"
 #  endif
@@ -5743,7 +5823,9 @@ typedef struct am_table_short AMTS;
 
 #endif /* !USE_LOCALE_NUMERIC */
 
-#if defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)
+#ifdef USE_QUADMATH
+#  define Perl_strtod(s, e) strtoflt128(s, e)
+#elif defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)
 #  if defined(HAS_STRTOLD)
 #    define Perl_strtod(s, e) strtold(s, e)
 #  elif defined(HAS_STRTOD)