In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/3d9d921361f2006519dd73511a4908624cf7dc58?hp=9a7aaf5783774d0974f8e80c4d6572d213f7fd92>
- Log ----------------------------------------------------------------- commit 3d9d921361f2006519dd73511a4908624cf7dc58 Author: Jarkko Hietaniemi <[email protected]> Date: Sun Aug 31 12:12:37 2014 -0400 =for apidoc wrong api M numeric.c commit d1877901c76d255ce8d75b4caeca181154b9dc50 Author: Jarkko Hietaniemi <[email protected]> Date: Sun Aug 31 12:04:46 2014 -0400 Couple more infnan tests. M t/op/infnan.t commit 0fa5dd23a49906857fa01fff069436c5e15e6501 Author: Jarkko Hietaniemi <[email protected]> Date: Sun Aug 31 10:35:35 2014 -0400 sqrt() disappeared in OSX, assuming it became pow(). Use exp() instead, less likely to disappear. Yes, handwaving. M t/porting/libperl.t commit 8bbccb2760d5298c0a744cdaf134e8097fcffc02 Author: Jarkko Hietaniemi <[email protected]> Date: Sun Aug 31 09:48:46 2014 -0400 AIX: if long doubles do not mix with infinity, disable long doubles. M hints/aix.sh commit e014a478acd9c2ad735f654343a1a60746337cb2 Author: Jarkko Hietaniemi <[email protected]> Date: Sun Aug 31 09:21:30 2014 -0400 Detect HAS_AIX_POWL_NEG_BASE_BUG in hints/aix.sh M hints/aix.sh commit 25c46df8dc6aa595a691c33917e6457c632a40aa Author: Jarkko Hietaniemi <[email protected]> Date: Sun Aug 31 08:34:10 2014 -0400 The fp classification is a royal mess. Try avoiding false detections by guarding against an interface falsely matching a set of return values. This can still go wrong if <math.h> declares several sets. Would really need an array of Configure tests. M perl.h commit 10decdeb9bd4a71279d64552b9a4d9b038bda788 Author: Jarkko Hietaniemi <[email protected]> Date: Sat Aug 30 23:39:28 2014 -0400 Wrong result for double-double sqrt(2). M t/op/sprintf2.t commit fde718697ab7ac6b3ae22c2c017feaa260064f4d Author: Jarkko Hietaniemi <[email protected]> Date: Sat Aug 30 23:13:27 2014 -0400 S_infnan_copy needs at most 5 bytes of output size. M sv.c commit 402bce5fcde176134b212beb8662ea0e2c5ce993 Author: Jarkko Hietaniemi <[email protected]> Date: Sat Aug 30 21:14:12 2014 -0400 Do not test sin/cos at [+-]pi, either. With AIX and long doubles you may not get exactly the approximation of pi you were thinking of. "This is not the pi you are looking for". M t/op/exp.t commit af71714e5ef5109f8a41bdcfe59da43540fcd651 Author: Jarkko Hietaniemi <[email protected]> Date: Sat Aug 30 21:11:30 2014 -0400 Avoid using function pointers for math functions. Otherwise AIX with long double has issues, see perl #122571. AIX has some rather intricate arrangement of symbols and macros. Also, it is okay to use two switches instead of just one. M pp.c ----------------------------------------------------------------------- Summary of changes: hints/aix.sh | 55 +++++++++++++++++- numeric.c | 2 +- perl.h | 163 ++++++++++++++++++++++++++++++++-------------------- pp.c | 39 ++++++------- sv.c | 10 ++-- t/op/exp.t | 22 ++++--- t/op/infnan.t | 9 ++- t/op/sprintf2.t | 2 +- t/porting/libperl.t | 8 +-- 9 files changed, 201 insertions(+), 109 deletions(-) diff --git a/hints/aix.sh b/hints/aix.sh index 675cfa6..22a3310 100644 --- a/hints/aix.sh +++ b/hints/aix.sh @@ -34,7 +34,6 @@ d_setrgid='undef' d_setruid='undef' alignbytes=8 - case "$usemymalloc" in '') usemymalloc='n' ;; esac @@ -544,4 +543,58 @@ if [ -f "/opt/freeware/include/gdbm/dbm.h" ] || i_gdbm='undef' i_gdbmndbm='undef' fi + +# Some releases (and patch levels) of AIX cannot have both +# long doubles and infinity (infinity plus one equals ... NaNQ!) +case "$uselongdouble" in +define) + echo "Checking if your infinity is working with long doubles..." >&4 + cat > inf$$.c <<EOF +#include <math.h> +#include <stdio.h> +int main() { + long double inf = INFINITY; + long double one = 1.0L; + printf("%Lg\n", inf + one); +} +EOF + $cc -qlongdouble -o inf$$ inf$$.c -lm + case `./inf$$` in + INF) echo "Your infinity is working correctly with long doubles." >&4 ;; + *) # NaNQ + echo "Your infinity is broken, disabling long doubles." >&4 + uselongdouble=undef + ccflags=`echo " $ccflags " | sed -e 's/ -qlongdouble / /'` + libswanted=`echo " $libswanted " | sed -e 's/ c128/ /'` + lddlflags=`echo " $lddlflags " | sed -e 's/ -lc128 / /'` + ;; + esac + rm -f inf$$.c inf$$ + ;; +esac + +# Some releases (and patch levels) of AIX have a broken powl(). +pp_cflags='' +case "$uselongdouble" in +define) + echo "Checking if your powl() is broken..." >&4 + cat > powl$$.c <<EOF +#include <math.h> +#include <stdio.h> +int main() { + printf("%Lg\n", powl(-3.0L, 2.0L)); +} +EOF + $cc -qlongdouble -o powl$$ powl$$.c -lm + case `./powl$$` in + 9) echo "Your powl() is working correctly." >&4 ;; + *) + echo "Your powl() is broken, will use a workaround." >&4 + pp_cflags='ccflags="$ccflags -DHAS_AIX_POWL_NEG_BASE_BUG"' + ;; + esac + rm -f powl$$.c powl$$ + ;; +esac + # EOF diff --git a/numeric.c b/numeric.c index 8de8491..e2f1007 100644 --- a/numeric.c +++ b/numeric.c @@ -1325,7 +1325,7 @@ Perl_my_atof2(pTHX_ const char* orig, NV* value) } /* -=for apidoc grok_atou +=for apidoc isinfnan Perl_isinfnan() is utility function that returns true if the NV argument is either an infinity or a NaN, false otherwise. To test diff --git a/perl.h b/perl.h index 354286c..5c296dc 100644 --- a/perl.h +++ b/perl.h @@ -2011,19 +2011,46 @@ EXTERN_C long double modfl(long double, long double *); * the sizeof() of its argument, so there's no need for e.g. fpclassifyl().*/ #if !defined(Perl_fp_class) && defined(HAS_FPCLASSIFY) # include <math.h> -# define Perl_fp_class(x) fpclassify(x) -# define Perl_fp_class_inf(x) (Perl_fp_class(x)==FP_INFINITE) -# define Perl_fp_class_nan(x) (Perl_fp_class(x)==FP_NAN) -# define Perl_fp_class_norm(x) (Perl_fp_class(x)==FP_NORMAL) -# define Perl_fp_class_denorm(x) (Perl_fp_class(x)==FP_SUBNORMAL) -# define Perl_fp_class_zero(x) (Perl_fp_class(x)==FP_ZERO) +# if defined(FP_INFINITE) && defined(FP_NAN) +# define Perl_fp_class(x) fpclassify(x) +# define Perl_fp_class_inf(x) (Perl_fp_class(x)==FP_INFINITE) +# define Perl_fp_class_nan(x) (Perl_fp_class(x)==FP_NAN) +# define Perl_fp_class_norm(x) (Perl_fp_class(x)==FP_NORMAL) +# define Perl_fp_class_denorm(x) (Perl_fp_class(x)==FP_SUBNORMAL) +# define Perl_fp_class_zero(x) (Perl_fp_class(x)==FP_ZERO) +# elif defined(FP_PLUS_INF) && defined(FP_QNAN) +/* Some versions of HP-UX (10.20) have (only) fpclassify() but which is + * actually not the C99 fpclassify, with its own set of return defines. */ +# define Perl_fp_class(x) fpclassify(x) +# define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_PLUS_INF) +# define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_MINUS_INF) +# define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_QNAN) +# define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_QNAN) +# define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_PLUS_NORM) +# define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_MINUIS_NORM) +# define Perl_fp_class_pdenorm(x) (Perl_fp_class(x)==FP_PLUS_DENORM) +# define Perl_fp_class_ndenorm(x) (Perl_fp_class(x)==FP_MINUS_DENORM) +# define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_PLUS_ZERO) +# define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_MINUS_ZERO) +# else +# undef Perl_fp_class /* Unknown set of defines */ +# endif #endif -/* Solaris and IRIX have fpclass/fpclassl, but they are using - * an enum typedef, not cpp symbols, and Configure doesn't detect that. - * Define one symbol also as a cpp symbol so we can detect it. */ -#if defined(__sun) || defined(__irix__) /* XXX Configure test instead */ -# define FP_SNAN FP_SNAN +/* fp_classify(): Legacy: VMS, maybe Unicos? The values, however, + * are identical to the C99 fpclassify(). */ +#if !defined(Perl_fp_class) && defined(HAS_FP_CLASSIFY) +# include <math.h> +# if defined(FP_INFINITE) && defined(FP_NAN) +# define Perl_fp_class(x) fp_classify(x) +# define Perl_fp_class_inf(x) (Perl_fp_class(x)==FP_INFINITE) +# define Perl_fp_class_nan(x) (Perl_fp_class(x)==FP_NAN) +# define Perl_fp_class_norm(x) (Perl_fp_class(x)==FP_NORMAL) +# define Perl_fp_class_denorm(x) (Perl_fp_class(x)==FP_SUBNORMAL) +# define Perl_fp_class_zero(x) (Perl_fp_class(x)==FP_ZERO) +# else +# undef Perl_fp_class /* Unknown set of defines */ +# endif #endif /* Feel free to check with me for the SGI manpages, SGI testing, @@ -2033,6 +2060,13 @@ EXTERN_C long double modfl(long double, long double *); /* fpclass(): SysV, at least Solaris and some versions of IRIX. */ #if !defined(Perl_fp_class) && (defined(HAS_FPCLASS)||defined(HAS_FPCLASSL)) +/* Solaris and IRIX have fpclass/fpclassl, but they are using + * an enum typedef, not cpp symbols, and Configure doesn't detect that. + * Define some symbols also as cpp symbols so we can detect them. */ +# if defined(__sun) || defined(__irix__) /* XXX Configure test instead */ +# define FP_PINF FP_PINF +# define FP_QNAN FP_QNAN +# endif # include <math.h> # ifdef I_IEEFP # include <ieeefp.h> @@ -2045,7 +2079,7 @@ EXTERN_C long double modfl(long double, long double *); # else # define Perl_fp_class(x) fpclass(x) # endif -# ifdef FP_CLASS_SNAN +# if defined(FP_CLASS_PINF) && defined(FP_CLASS_SNAN) # define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_CLASS_SNAN) # define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_CLASS_QNAN) # define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_CLASS_NINF) @@ -2056,7 +2090,7 @@ EXTERN_C long double modfl(long double, long double *); # define Perl_fp_class_pdenorm(x) (Perl_fp_class(x)==FP_CLASS_PDENORM) # define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_CLASS_NZERO) # define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_CLASS_PZERO) -# elif defined(FP_SNAN) +# elif defined(FP_PINF) && defined(FP_QNAN) # define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_SNAN) # define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_QNAN) # define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_NINF) @@ -2067,6 +2101,8 @@ EXTERN_C long double modfl(long double, long double *); # define Perl_fp_class_pdenorm(x) (Perl_fp_class(x)==FP_PDENORM) # define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_NZERO) # define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_PZERO) +# else +# undef Perl_fp_class /* Unknown set of defines */ # endif #endif @@ -2076,60 +2112,61 @@ EXTERN_C long double modfl(long double, long double *); # if !defined(FP_SNAN) && defined(I_FP_CLASS) # include <fp_class.h> # endif -# ifdef __irix__ /* XXX Configure test instead */ -# ifdef USE_LONG_DOUBLE -# define Perl_fp_class(x) fp_class_l(x) +# if defined(FP_POS_INF) && defined(FP_QNAN) +# ifdef __irix__ /* XXX Configure test instead */ +# ifdef USE_LONG_DOUBLE +# define Perl_fp_class(x) fp_class_l(x) +# else +# define Perl_fp_class(x) fp_class_d(x) +# endif # else -# define Perl_fp_class(x) fp_class_d(x) +# if defined(USE_LONG_DOUBLE) && defined(HAS_FP_CLASSL) +# define Perl_fp_class(x) fp_classl(x) +# else +# define Perl_fp_class(x) fp_class(x) +# endif # endif -# else -# if defined(USE_LONG_DOUBLE) && defined(HAS_FP_CLASSL) -# define Perl_fp_class(x) fp_classl(x) +# if defined(FP_POS_INF) && defined(FP_QNAN) +# define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_SNAN) +# define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_QNAN) +# define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_NEG_INF) +# define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_POS_INF) +# define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_NEG_NORM) +# define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_POS_NORM) +# define Perl_fp_class_ndenorm(x) (Perl_fp_class(x)==FP_NEG_DENORM) +# define Perl_fp_class_pdenorm(x) (Perl_fp_class(x)==FP_POS_DENORM) +# define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_NEG_ZERO) +# define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_POS_ZERO) # else -# define Perl_fp_class(x) fp_class(x) +# undef Perl_fp_class /* Unknown set of defines */ # endif # endif -# define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_SNAN) -# define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_QNAN) -# define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_NEG_INF) -# define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_POS_INF) -# define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_NEG_NORM) -# define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_POS_NORM) -# define Perl_fp_class_ndenorm(x) (Perl_fp_class(x)==FP_NEG_DENORM) -# define Perl_fp_class_pdenorm(x) (Perl_fp_class(x)==FP_POS_DENORM) -# define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_NEG_ZERO) -# define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_POS_ZERO) #endif /* class(), _class(): Legacy: AIX. */ #if !defined(Perl_fp_class) && defined(HAS_CLASS) # include <math.h> -# ifndef _cplusplus -# define Perl_fp_class(x) class(x) -# else -# define Perl_fp_class(x) _class(x) +# if defined(FP_PLUS_NORM) && defined(FP_PLUS_INF) +# ifndef _cplusplus +# define Perl_fp_class(x) class(x) +# else +# define Perl_fp_class(x) _class(x) +# endif +# if defined(FP_PLUS_INF) && defined(FP_NANQ) +# define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_NANS) +# define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_NANQ) +# define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_MINUS_INF) +# define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_PLUS_INF) +# define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_MINUS_NORM) +# define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_PLUS_NORM) +# define Perl_fp_class_ndenorm(x) (Perl_fp_class(x)==FP_MINUS_DENORM) +# define Perl_fp_class_pdenorm(x) (Perl_fp_class(x)==FP_PLUS_DENORM) +# define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_MINUS_ZERO) +# define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_PLUS_ZERO) +# else +# undef Perl_fp_class /* Unknown set of defines */ +# endif # endif -# define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_NANS) -# define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_NANQ) -# define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_MINUS_INF) -# define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_PLUS_INF) -# define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_MINUS_NORM) -# define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_PLUS_NORM) -# define Perl_fp_class_ndenorm(x) (Perl_fp_class(x)==FP_MINUS_DENORM) -# define Perl_fp_class_pdenorm(x) (Perl_fp_class(x)==FP_PLUS_DENORM) -# define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_MINUS_ZERO) -# define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_PLUS_ZERO) -#endif - -/* fp_classify(): Legacy: VMS, maybe Unicos? */ -#if !defined(Perl_fp_class) && defined(HAS_FP_CLASSIFY) -# include <math.h> -# define Perl_fp_class(x) fp_classify(x) -# define Perl_fp_class_inf(x) (Perl_fp_class(x)==FP_INFINITE) -# define Perl_fp_class_nan(x) (Perl_fp_class(x)==FP_NAN) -# define Perl_fp_class_norm(x) (Perl_fp_class(x)==FP_NORMAL) -# define Perl_fp_class_denorm(x) (Perl_fp_class(x)==FP_SUBNORMAL) -# define Perl_fp_class_zero(x) (Perl_fp_class(x)==FP_ZERO) #endif /* Win32: _fpclass(), _isnan(), _finite(). */ @@ -2141,6 +2178,8 @@ EXTERN_C long double modfl(long double, long double *); # define Perl_isfinite(x) _finite(x) # endif # ifndef Perl_fp_class_snan +/* No simple way to #define Perl_fp_class because _fpclass() + * returns a set of bits. */ # define Perl_fp_class_snan(x) (_fpclass(x) & _FPCLASS_SNAN) # define Perl_fp_class_qnan(x) (_fpclass(x) & _FPCLASS_QNAN) # define Perl_fp_class_nan(x) (_fpclass(x) & (_FPCLASS_QNAN|_FPCLASS_QNAN)) @@ -2208,26 +2247,28 @@ int isnan(double d); #ifndef Perl_isinf # ifdef Perl_fp_class_inf # define Perl_isinf(x) Perl_fp_class_inf(x) -# elif defined(Perl_isfinite) && defined(Perl_isnan) -# define Perl_isinf(x) !(Perl_isfinite(x)||Perl_isnan(x)) # endif #endif #ifndef Perl_isfinite -# ifdef HAS_ISFINITE +# if defined(HAS_ISFINITE) && !defined(isfinite) # define Perl_isfinite(x) isfinite((double)x) # elif defined(HAS_FINITE) # define Perl_isfinite(x) finite((double)x) # elif defined(Perl_fp_class_finite) # define Perl_isfinite(x) Perl_fp_class_finite(x) -# elif defined(Perl_is_inf) && defined(Perl_is_nan) -# define Perl_isfinite(x) !(Perl_is_inf(x)||Perl_is_nan(x)) # else /* NaN*0 is NaN, [+-]Inf*0 is NaN, zero for anything else. */ # define Perl_isfinite(x) (((x) * 0) == 0) # endif #endif +#ifndef Perl_isinf +# if defined(Perl_isfinite) && defined(Perl_isnan) +# define Perl_isinf(x) !(Perl_isfinite(x)||Perl_isnan(x)) +# 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. diff --git a/pp.c b/pp.c index f86e276..723986c 100644 --- a/pp.c +++ b/pp.c @@ -2685,45 +2685,40 @@ PP(pp_atan2) PP(pp_sin) { dSP; dTARGET; - int amg_type = sin_amg; + int amg_type = fallback_amg; const char *neg_report = NULL; - NV (*func)(NV) = Perl_sin; const int op_type = PL_op->op_type; switch (op_type) { - case OP_COS: - amg_type = cos_amg; - func = Perl_cos; - break; - case OP_EXP: - amg_type = exp_amg; - func = Perl_exp; - break; - case OP_LOG: - amg_type = log_amg; - func = Perl_log; - neg_report = "log"; - break; - case OP_SQRT: - amg_type = sqrt_amg; - func = Perl_sqrt; - neg_report = "sqrt"; - break; + case OP_SIN: amg_type = sin_amg; break; + case OP_COS: amg_type = cos_amg; break; + case OP_EXP: amg_type = exp_amg; break; + case OP_LOG: amg_type = log_amg; neg_report = "log"; break; + case OP_SQRT: amg_type = sqrt_amg; neg_report = "sqrt"; break; } + assert(amg_type != fallback_amg); tryAMAGICun_MG(amg_type, 0); { SV * const arg = POPs; const NV value = SvNV_nomg(arg); - if (neg_report) { + NV result; + if (neg_report) { /* log or sqrt */ if (op_type == OP_LOG ? (value <= 0.0) : (value < 0.0)) { SET_NUMERIC_STANDARD(); /* diag_listed_as: Can't take log of %g */ DIE(aTHX_ "Can't take %s of %"NVgf, neg_report, value); } } - XPUSHn(func(value)); + switch (op_type) { + case OP_SIN: result = Perl_sin(value); break; + case OP_COS: result = Perl_cos(value); break; + case OP_EXP: result = Perl_exp(value); break; + case OP_LOG: result = Perl_log(value); break; + case OP_SQRT: result = Perl_sqrt(value); break; + } + XPUSHn(result); RETURN; } } diff --git a/sv.c b/sv.c index 5f88508..7d4c964 100644 --- a/sv.c +++ b/sv.c @@ -2772,9 +2772,9 @@ S_uiv_2buf(char *const buf, const IV iv, UV uv, const int is_uv, char **const pe } /* Helper for sv_2pv_flags and sv_vcatpvfn_flags. If the NV is an -* infinity or a not-a-number, writes the appropriate strings to the -* buffer, including a zero byte. On success returns the written length, -* excluding the zero byte, on failure returns zero. */ + * infinity or a not-a-number, writes the appropriate strings to the + * buffer, including a zero byte. On success returns the written length, + * excluding the zero byte, on failure returns zero. */ STATIC size_t S_infnan_copy(NV nv, char* buffer, size_t maxlen) { if (maxlen < 4) @@ -2991,7 +2991,7 @@ Perl_sv_2pv_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags) /* The +20 is pure guesswork. Configure test needed. --jhi */ s = SvGROW_mutable(sv, NV_DIG + 20); - len = S_infnan_copy(SvNVX(sv), s, SvLEN(sv)); + len = S_infnan_copy(SvNVX(sv), s, 5); if (len > 0) s += len; else { @@ -12038,7 +12038,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p } } else - elen = S_infnan_copy(nv, PL_efloatbuf, PL_efloatsize); + elen = S_infnan_copy(nv, PL_efloatbuf, 5); if (elen == 0) { char *ptr = ebuf + sizeof ebuf; *--ptr = '\0'; diff --git a/t/op/exp.t b/t/op/exp.t index a475502..f97b6d8 100644 --- a/t/op/exp.t +++ b/t/op/exp.t @@ -8,7 +8,7 @@ BEGIN { require './test.pl'; } -plan tests => 34; +plan tests => 30; # compile time evaluation @@ -78,10 +78,12 @@ is(substr($s,0,5), '0.693', 'run time log(2)'); cmp_ok(exp(log($x1)), '==', 1, 'run time exp(log(1)) == 1'); -# tests for transcendental functions +# NOTE: do NOT test the trigonometric functions at [+-]Pi +# and expect to get exact results like 0, 1, -1, because +# you may not be able to feed them exactly [+-]Pi given +# all the variations of different long doubles. -my $pi = 3.1415926535897931160; -my $pi_2 = 1.5707963267948965580; +my $pi_2 = 1.5707963267949; sub round { my $result = shift; @@ -90,19 +92,15 @@ sub round { # sin() tests cmp_ok(sin(0), '==', 0.0, 'sin(0) == 0'); -cmp_ok(round(sin($pi)), '==', 0.0, 'sin(pi) == 0'); -cmp_ok(round(sin(-1 * $pi)), '==', 0.0, 'sin(-pi) == 0'); -cmp_ok(round(sin($pi_2)), '==', 1.0, 'sin(pi/2) == 1'); -cmp_ok(round(sin(-1 * $pi_2)), '==', -1.0, 'sin(-pi/2) == -1'); +cmp_ok(abs(sin($pi_2) - 1), '<', 1e-9, 'sin(pi/2) == 1'); +cmp_ok(abs(sin(-1 * $pi_2) - -1), '<', 1e-9, 'sin(-pi/2) == -1'); cmp_ok(round(sin($x1)), '==', '0.841470985', "sin(1)"); # cos() tests cmp_ok(cos(0), '==', 1.0, 'cos(0) == 1'); -cmp_ok(round(cos($pi)), '==', -1.0, 'cos(pi) == -1'); -cmp_ok(round(cos(-1 * $pi)), '==', -1.0, 'cos(-pi) == -1'); -cmp_ok(round(cos($pi_2)), '==', 0.0, 'cos(pi/2) == 0'); -cmp_ok(round(cos(-1 * $pi_2)), '==', 0.0, 'cos(-pi/2) == 0'); +cmp_ok(abs(cos($pi_2)), '<', 1e-9, 'cos(pi/2) == 0'); +cmp_ok(abs(cos(-1 * $pi_2)), '<', 1e-9, 'cos(-pi/2) == 0'); cmp_ok(round(cos($x1)), '==', '0.540302306', "cos(1)"); diff --git a/t/op/infnan.t b/t/op/infnan.t index c147787..3a8be8e 100644 --- a/t/op/infnan.t +++ b/t/op/infnan.t @@ -24,8 +24,8 @@ my @NaN = ("NAN", "nan", "qnan", "SNAN", "NanQ", "NANS", my @num_fmt = qw(e f g a d u o b x p); -my $inf_tests = 11 + @num_fmt + 8 + 3 * @PInf + 3 * @NInf + 5 + 3; -my $nan_tests = 7 + @num_fmt + 4 + 2 * @NaN + 3; +my $inf_tests = 13 + @num_fmt + 8 + 3 * @PInf + 3 * @NInf + 5 + 3; +my $nan_tests = 8 + @num_fmt + 4 + 2 * @NaN + 3; my $infnan_tests = 4; @@ -54,6 +54,9 @@ SKIP: { cmp_ok($PInf * 2, '==', $PInf, "twice Inf is Inf"); cmp_ok($PInf / 2, '==', $PInf, "half of Inf is Inf"); + cmp_ok($PInf + 1, '==', $PInf, "Inf + one is Inf"); + cmp_ok($NInf + 1, '==', $NInf, "-Inf + one is -Inf"); + is(sprintf("%g", $PInf), "Inf", "$PInf sprintf %g is Inf"); is(sprintf("%a", $PInf), "Inf", "$PInf sprintf %a is Inf"); @@ -124,6 +127,8 @@ SKIP: { is($NaN * 2, $NaN, "twice NaN is NaN"); is($NaN / 2, $NaN, "half of NaN is NaN"); + is($NaN + 1, $NaN, "NaN + one is NaN"); + for my $f (@num_fmt) { is(sprintf("%$f", $NaN), "NaN", "$NaN sprintf %$f is NaN"); } diff --git a/t/op/sprintf2.t b/t/op/sprintf2.t index bcb7d63..4ab688e 100644 --- a/t/op/sprintf2.t +++ b/t/op/sprintf2.t @@ -204,7 +204,7 @@ if ($Config{nvsize} == 8 && [ '%a', '-3.14', '-0x1.91eb851eb851fp+1' ], [ '%a', '0.1', '0x1.999999999999ap-4' ], [ '%a', '1/7', '0x1.2492492492492p-3' ], - [ '%a', 'sqrt(2)', '0x1.6a09e661366ebp+0' ], + [ '%a', 'sqrt(2)', '0x1.6a09e667f3bcdp+0' ], [ '%a', 'exp(1)', '0x1.5bf0a8b145769p+1' ], [ '%a', '2**-10', '0x1p-10' ], [ '%a', '2**10', '0x1p+10' ], diff --git a/t/porting/libperl.t b/t/porting/libperl.t index 0fe212b..366bfd9 100644 --- a/t/porting/libperl.t +++ b/t/porting/libperl.t @@ -418,8 +418,8 @@ ok(keys %{$symbols{undef}}, "has undefined symbols"); # There are certain symbols we expect to see. -# chmod, socket, getenv, sigaction, sqrt, time are system/library -# calls that should each see at least one use. sqrt can be sqrtl +# chmod, socket, getenv, sigaction, exp, time are system/library +# calls that should each see at least one use. exp can be expl # if so configured. my %expected = ( chmod => undef, # There is no Configure symbol for chmod. @@ -430,9 +430,9 @@ my %expected = ( ); if ($Config{uselongdouble} && $Config{d_longdbl}) { - $expected{sqrtl} = 'd_sqrtl'; + $expected{expl} = undef; # There is no Configure symbol for expl. } else { - $expected{sqrt} = undef; # There is no Configure symbol for sqrt. + $expected{exp} = undef; # There is no Configure symbol for exp. } # DynaLoader will use dlopen, unless we are building static, -- Perl5 Master Repository
