In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/ee2276e59a3c027cb89c721d866c9db4ba683a7b?hp=2b7eb4debacea522345b51816a4abc9d222804ce>
- Log ----------------------------------------------------------------- commit ee2276e59a3c027cb89c721d866c9db4ba683a7b Author: Jarkko Hietaniemi <[email protected]> Date: Tue Sep 23 08:17:47 2014 -0400 AIX doesn't set the length in getsockopt. [perl #120835] and [rt #91183] and [rt #85570] Seen errors in blead smoke in AIX 6.1: cpan/IO-Socket-IP/t/18fdopen .................................. Argument "\0\0\0^A\0\0\0r\0\0\0\0\0\0\0\0?M-^U\0\0M-^E^[^???\0^N\0..." isn't numeric in numeric eq (==) at ../../lib/IO/Socket/IP.pm line 748. cpan/IO-Socket-IP/t/31nonblocking-connect-internet ............ Argument "\0\0\0\0\0\0\0\0?\0\n^B1?\0\0\0^B\0^BM-\rf?^H?\0^N\0^B?|..." isn't numeric in scalar assignment at ../../lib/IO/Socket/IP.pm line 707. M pp_sys.c commit 0f83c5a4f945d1919a6ff6564a3a18375f15f949 Author: Jarkko Hietaniemi <[email protected]> Date: Mon Sep 22 21:37:38 2014 -0400 Avoid mixing Inf/NaN with IV/UV. It really makes no sense to ask what's the IV/UV of this Inf/NaN, or turn on the IOK/UV flags (private or public). M sv.c commit c32c3de1f087531defe6795e7997f2f5d532ba7d Author: Jarkko Hietaniemi <[email protected]> Date: Mon Sep 22 21:18:28 2014 -0400 Move the VC6 "broken-nan" define from win32.h to perl.h. M perl.h M win32/win32.h ----------------------------------------------------------------------- Summary of changes: perl.h | 13 ++-- pp_sys.c | 5 ++ sv.c | 209 ++++++++++++++++++++++++++++------------------------------ win32/win32.h | 6 -- 4 files changed, 111 insertions(+), 122 deletions(-) diff --git a/perl.h b/perl.h index 0b8e1db..7f29706 100644 --- a/perl.h +++ b/perl.h @@ -1857,6 +1857,12 @@ typedef NVTYPE NV; # include <ieeefp.h> #endif +#ifdef USING_MSVC6 +/* VC6 has broken NaN semantics: NaN == NaN returns true instead of false, + * and for example NaN < IV_MIN. */ +#define NAN_COMPARE_BROKEN 1 +#endif + #ifdef USE_LONG_DOUBLE # ifdef I_SUNMATH # include <sunmath.h> @@ -3029,13 +3035,6 @@ typedef pthread_key_t perl_key; #if defined(WIN32) # include "win32.h" -# ifdef NAN_COMPARE_BROKEN /* VC6 */ -/* We need to redefine Perl_isinf() because we most likely defined it - * using the <DBL_MIN || >DBL_MAX way, which is broken if the NaN - * compare is broken. */ -# undef Perl_isinf -# define Perl_isinf(x) Perl_fp_class_inf(x) -# endif #endif #ifdef NETWARE diff --git a/pp_sys.c b/pp_sys.c index ac2a87c..014ec42 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -2676,6 +2676,11 @@ PP(pp_ssockopt) len = SvCUR(sv); if (PerlSock_getsockopt(fd, lvl, optname, SvPVX(sv), &len) < 0) goto nuts2; +#if defined(_AIX) + /* XXX Configure test: does getsockopt set the length properly? */ + if (len == 256) + len = sizeof(int); +#endif SvCUR_set(sv, len); *SvEND(sv) ='\0'; PUSHs(sv); diff --git a/sv.c b/sv.c index 4dede1a..06e23ed 100644 --- a/sv.c +++ b/sv.c @@ -2075,6 +2075,9 @@ S_sv_2iuv_common(pTHX_ SV *const sv) * IV or UV at same time to avoid this. */ /* IV-over-UV optimisation - choose to cache IV if possible */ + if (Perl_isinfnan(SvNVX(sv))) + return FALSE; + if (SvTYPE(sv) == SVt_NV) sv_upgrade(sv, SVt_PVNV); @@ -2083,13 +2086,6 @@ S_sv_2iuv_common(pTHX_ SV *const sv) certainly cast into the IV range at IV_MAX, whereas the correct answer is the UV IV_MAX +1. Hence < ensures that dodgy boundary cases go to UV */ -#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan) - if (Perl_isnan(SvNVX(sv))) { - SvUV_set(sv, 0); - SvIsUV_on(sv); - return FALSE; - } -#endif if (SvNVX(sv) < (NV)IV_MAX + 0.5) { SvIV_set(sv, I_V(SvNVX(sv))); if (SvNVX(sv) == (NV) SvIVX(sv) @@ -2236,13 +2232,6 @@ S_sv_2iuv_common(pTHX_ SV *const sv) #ifdef NV_PRESERVES_UV (void)SvIOKp_on(sv); (void)SvNOK_on(sv); -#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan) - if (Perl_isnan(SvNVX(sv))) { - SvUV_set(sv, 0); - SvIsUV_on(sv); - return FALSE; - } -#endif if (SvNVX(sv) < (NV)IV_MAX + 0.5) { SvIV_set(sv, I_V(SvNVX(sv))); if ((NV)(SvIVX(sv)) == SvNVX(sv)) { @@ -2352,6 +2341,9 @@ Perl_sv_2iv_flags(pTHX_ SV *const sv, const I32 flags) if (SvGMAGICAL(sv) && (flags & SV_GMAGIC)) mg_get(sv); + if (SvNOK(sv) && Perl_isinfnan(SvNVX(sv))) + return 0; /* So wrong but what can we do. */ + if (SvROK(sv)) { if (SvAMAGIC(sv)) { SV * tmpstr; @@ -2379,8 +2371,9 @@ Perl_sv_2iv_flags(pTHX_ SV *const sv, const I32 flags) UV value; const char * const ptr = isREGEXP(sv) ? RX_WRAPPED((REGEXP*)sv) : SvPVX_const(sv); - const int numtype - = grok_number(ptr, SvCUR(sv), &value); + const int numtype = grok_number(ptr, SvCUR(sv), &value); + + assert((numtype & (IS_NUMBER_INFINITY | IS_NUMBER_NAN)) == 0); if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT)) == IS_NUMBER_IN_UV) { @@ -2394,13 +2387,6 @@ Perl_sv_2iv_flags(pTHX_ SV *const sv, const I32 flags) } } - /* Quite wrong but no good choices. */ - if ((numtype & IS_NUMBER_INFINITY)) { - return (numtype & IS_NUMBER_NEG) ? IV_MIN : IV_MAX; - } else if ((numtype & IS_NUMBER_NAN)) { - return 0; /* So wrong. */ - } - if (!numtype) { if (ckWARN(WARN_NUMERIC)) not_a_number(sv); @@ -2450,6 +2436,9 @@ Perl_sv_2uv_flags(pTHX_ SV *const sv, const I32 flags) if (SvGMAGICAL(sv) && (flags & SV_GMAGIC)) mg_get(sv); + if (SvNOK(sv) && Perl_isinfnan(SvNVX(sv))) + return 0; /* So wrong but what can we do. */ + if (SvROK(sv)) { if (SvAMAGIC(sv)) { SV *tmpstr; @@ -2472,8 +2461,9 @@ Perl_sv_2uv_flags(pTHX_ SV *const sv, const I32 flags) UV value; const char * const ptr = isREGEXP(sv) ? RX_WRAPPED((REGEXP*)sv) : SvPVX_const(sv); - const int numtype - = grok_number(ptr, SvCUR(sv), &value); + const int numtype = grok_number(ptr, SvCUR(sv), &value); + + assert((numtype & (IS_NUMBER_INFINITY | IS_NUMBER_NAN)) == 0); if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT)) == IS_NUMBER_IN_UV) { @@ -2482,13 +2472,6 @@ Perl_sv_2uv_flags(pTHX_ SV *const sv, const I32 flags) return value; } - /* Quite wrong but no good choices. */ - if ((numtype & IS_NUMBER_INFINITY)) { - return UV_MAX; /* So wrong. */ - } else if ((numtype & IS_NUMBER_NAN)) { - return 0; /* So wrong. */ - } - if (!numtype) { if (ckWARN(WARN_NUMERIC)) not_a_number(sv); @@ -2640,11 +2623,11 @@ Perl_sv_2nv_flags(pTHX_ SV *const sv, const I32 flags) /* It's definitely an integer */ SvNV_set(sv, (numtype & IS_NUMBER_NEG) ? -(NV)value : (NV)value); } else { - if ((numtype & IS_NUMBER_INFINITY)) { + if ((numtype & IS_NUMBER_INFINITY)) SvNV_set(sv, (numtype & IS_NUMBER_NEG) ? -NV_INF : NV_INF); - } else if ((numtype & IS_NUMBER_NAN)) { + else if ((numtype & IS_NUMBER_NAN)) SvNV_set(sv, NV_NAN); - } else + else SvNV_set(sv, Atof(SvPVX_const(sv))); } if (numtype) @@ -2652,100 +2635,107 @@ Perl_sv_2nv_flags(pTHX_ SV *const sv, const I32 flags) else SvNOKp_on(sv); #else - SvNV_set(sv, Atof(SvPVX_const(sv))); - /* Only set the public NV OK flag if this NV preserves the value in - the PV at least as well as an IV/UV would. - Not sure how to do this 100% reliably. */ - /* if that shift count is out of range then Configure's test is - wonky. We shouldn't be in here with NV_PRESERVES_UV_BITS == - UV_BITS */ - if (((UV)1 << NV_PRESERVES_UV_BITS) > - U_V(SvNVX(sv) > 0 ? SvNVX(sv) : -SvNVX(sv))) { - SvNOK_on(sv); /* Definitely small enough to preserve all bits */ - } else if (!(numtype & IS_NUMBER_IN_UV)) { - /* Can't use strtol etc to convert this string, so don't try. - sv_2iv and sv_2uv will use the NV to convert, not the PV. */ + if ((numtype & IS_NUMBER_INFINITY)) { + SvNV_set(sv, (numtype & IS_NUMBER_NEG) ? -NV_INF : NV_INF); + SvNOK_on(sv); + } else if ((numtype & IS_NUMBER_NAN)) { + SvNV_set(sv, NV_NAN); SvNOK_on(sv); } else { - /* value has been set. It may not be precise. */ - if ((numtype & IS_NUMBER_NEG) && (value > (UV)IV_MIN)) { - /* 2s complement assumption for (UV)IV_MIN */ - SvNOK_on(sv); /* Integer is too negative. */ + SvNV_set(sv, Atof(SvPVX_const(sv))); + /* Only set the public NV OK flag if this NV preserves the value in + the PV at least as well as an IV/UV would. + Not sure how to do this 100% reliably. */ + /* if that shift count is out of range then Configure's test is + wonky. We shouldn't be in here with NV_PRESERVES_UV_BITS == + UV_BITS */ + if (((UV)1 << NV_PRESERVES_UV_BITS) > + U_V(SvNVX(sv) > 0 ? SvNVX(sv) : -SvNVX(sv))) { + SvNOK_on(sv); /* Definitely small enough to preserve all bits */ + } else if (!(numtype & IS_NUMBER_IN_UV)) { + /* Can't use strtol etc to convert this string, so don't try. + sv_2iv and sv_2uv will use the NV to convert, not the PV. */ + SvNOK_on(sv); } else { - SvNOKp_on(sv); - SvIOKp_on(sv); - - if (numtype & IS_NUMBER_NEG) { - SvIV_set(sv, -(IV)value); - } else if (value <= (UV)IV_MAX) { - SvIV_set(sv, (IV)value); - } else { - SvUV_set(sv, value); - SvIsUV_on(sv); - } - - if (numtype & IS_NUMBER_NOT_INT) { - /* I believe that even if the original PV had decimals, - they are lost beyond the limit of the FP precision. - However, neither is canonical, so both only get p - flags. NWC, 2000/11/25 */ - /* Both already have p flags, so do nothing */ + /* value has been set. It may not be precise. */ + if ((numtype & IS_NUMBER_NEG) && (value > (UV)IV_MIN)) { + /* 2s complement assumption for (UV)IV_MIN */ + SvNOK_on(sv); /* Integer is too negative. */ } else { - const NV nv = SvNVX(sv); - /* XXX should this spot have NAN_COMPARE_BROKEN, too? */ - if (SvNVX(sv) < (NV)IV_MAX + 0.5) { - if (SvIVX(sv) == I_V(nv)) { - SvNOK_on(sv); - } else { - /* It had no "." so it must be integer. */ - } - SvIOK_on(sv); + SvNOKp_on(sv); + SvIOKp_on(sv); + + if (numtype & IS_NUMBER_NEG) { + SvIV_set(sv, -(IV)value); + } else if (value <= (UV)IV_MAX) { + SvIV_set(sv, (IV)value); } else { - /* between IV_MAX and NV(UV_MAX). - Could be slightly > UV_MAX */ + SvUV_set(sv, value); + SvIsUV_on(sv); + } - if (numtype & IS_NUMBER_NOT_INT) { - /* UV and NV both imprecise. */ + if (numtype & IS_NUMBER_NOT_INT) { + /* I believe that even if the original PV had decimals, + they are lost beyond the limit of the FP precision. + However, neither is canonical, so both only get p + flags. NWC, 2000/11/25 */ + /* Both already have p flags, so do nothing */ + } else { + const NV nv = SvNVX(sv); + if (SvNVX(sv) < (NV)IV_MAX + 0.5) { + if (SvIVX(sv) == I_V(nv)) { + SvNOK_on(sv); + } else { + /* It had no "." so it must be integer. */ + } + SvIOK_on(sv); } else { - const UV nv_as_uv = U_V(nv); + /* between IV_MAX and NV(UV_MAX). + Could be slightly > UV_MAX */ - if (value == nv_as_uv && SvUVX(sv) != UV_MAX) { - SvNOK_on(sv); + if (numtype & IS_NUMBER_NOT_INT) { + /* UV and NV both imprecise. */ + } else { + const UV nv_as_uv = U_V(nv); + + if (value == nv_as_uv && SvUVX(sv) != UV_MAX) { + SvNOK_on(sv); + } + SvIOK_on(sv); } - SvIOK_on(sv); } } } } - } - /* It might be more code efficient to go through the entire logic above - and conditionally set with SvNOKp_on() rather than SvNOK(), but it - gets complex and potentially buggy, so more programmer efficient + /* It might be more code efficient to go through the entire logic above + and conditionally set with SvNOKp_on() rather than SvNOK(), but it + gets complex and potentially buggy, so more programmer efficient to do it this way, by turning off the public flags: */ - if (!numtype) - SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK); + if (!numtype) + SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK); + } #endif /* NV_PRESERVES_UV */ } else { - if (isGV_with_GP(sv)) { - glob_2number(MUTABLE_GV(sv)); - return 0.0; - } + if (isGV_with_GP(sv)) { + glob_2number(MUTABLE_GV(sv)); + return 0.0; + } - if (!PL_localizing && ckWARN(WARN_UNINITIALIZED)) - report_uninit(sv); - assert (SvTYPE(sv) >= SVt_NV); - /* Typically the caller expects that sv_any is not NULL now. */ - /* XXX Ilya implies that this is a bug in callers that assume this - and ideally should be fixed. */ - return 0.0; + if (!PL_localizing && ckWARN(WARN_UNINITIALIZED)) + report_uninit(sv); + assert (SvTYPE(sv) >= SVt_NV); + /* Typically the caller expects that sv_any is not NULL now. */ + /* XXX Ilya implies that this is a bug in callers that assume this + and ideally should be fixed. */ + return 0.0; } DEBUG_c({ - STORE_NUMERIC_LOCAL_SET_STANDARD(); - PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2nv(%" NVgf ")\n", - PTR2UV(sv), SvNVX(sv)); - RESTORE_NUMERIC_LOCAL(); - }); + STORE_NUMERIC_LOCAL_SET_STANDARD(); + PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2nv(%" NVgf ")\n", + PTR2UV(sv), SvNVX(sv)); + RESTORE_NUMERIC_LOCAL(); + }); return SvNVX(sv); } @@ -3029,6 +3019,7 @@ Perl_sv_2pv_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags) sv_upgrade(sv, SVt_PVNV); if (SvNVX(sv) == 0.0 #if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan) + /* XXX Create SvNVXeq(sv, x)? Or just SvNVXzero(sv)? */ && !Perl_isnan(SvNVX(sv)) #endif ) { diff --git a/win32/win32.h b/win32/win32.h index 8587ac8..46adb15 100644 --- a/win32/win32.h +++ b/win32/win32.h @@ -254,12 +254,6 @@ typedef unsigned short mode_t; #define snprintf _snprintf #define vsnprintf _vsnprintf -#ifdef USING_MSVC6 -/* VC6 has broken NaN semantics: NaN == NaN returns true instead of false, - * and for example NaN < IV_MIN. */ -#define NAN_COMPARE_BROKEN 1 -#endif - /* on VC2003, msvcrt.lib is missing these symbols */ #if _MSC_VER >= 1300 && _MSC_VER < 1400 # pragma intrinsic(_rotl64,_rotr64) -- Perl5 Master Repository
