In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/c9a671b17a9c588469bcef958038daaaaf9cc88b?hp=9024667a44828cc925a3d939578415da8ffeec83>
- Log ----------------------------------------------------------------- commit c9a671b17a9c588469bcef958038daaaaf9cc88b Author: Jarkko Hietaniemi <[email protected]> Date: Tue Feb 10 13:26:50 2015 -0500 infnan: change the invalid nan message, add to perldiag M numeric.c M pod/perldiag.pod commit 99fcdd4df47515fb0a62a046e622adec0871754d Author: Jarkko Hietaniemi <[email protected]> Date: Tue Feb 10 13:18:20 2015 -0500 infnan: "nan(1)cy" should numify to $NaN, but also warn More test cases. M numeric.c M t/op/infnan.t ----------------------------------------------------------------------- Summary of changes: numeric.c | 15 +++++++++------ pod/perldiag.pod | 8 ++++++++ t/op/infnan.t | 16 ++++++++++++++++ 3 files changed, 33 insertions(+), 6 deletions(-) diff --git a/numeric.c b/numeric.c index 9b1b2ae..bc5913e 100644 --- a/numeric.c +++ b/numeric.c @@ -692,7 +692,7 @@ Perl_nan_is_signaling(NV nv) * precision of 128 bits. */ #define MAX_NV_BYTES (128/8) -static const char nan_payload_error[] = "NaN payload error"; +static const char invalid_nan_payload[] = "Invalid NaN payload"; /* @@ -775,8 +775,8 @@ Perl_nan_payload_set(pTHX_ NV *nvp, const void *bytes, STRLEN byten, bool signal *hibyte &= ~mask; } if (error) { - Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW), - nan_payload_error); + Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW), + invalid_nan_payload); } nan_signaling_set(nvp, signaling); } @@ -806,8 +806,11 @@ Perl_grok_nan_payload(pTHX_ const char* s, const char* send, bool signaling, int * "nan0xabc", or "nan(s123)" ("s" for signaling). */ while (t > s && isSPACE(*t)) t--; + if (*t != ')') { - return send; + U8 bytes[1] = { 0 }; + nan_payload_set(nvp, bytes, 1, signaling); + return t; } if (++s == send) { @@ -914,8 +917,8 @@ Perl_grok_nan_payload(pTHX_ const char* s, const char* send, bool signaling, int } if (error) { - Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW), - nan_payload_error); + Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW), + invalid_nan_payload); } if (s == send) { diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 877b992..54c4d85 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -2790,6 +2790,14 @@ where C<foo> is not a valid method resolution order (MRO). Currently, the only valid ones supported are C<dfs> and C<c3>, unless you have loaded a module that is a MRO plugin. See L<mro> and L<perlmroapi>. +=item Invalid NaN payload + +(W overflow) C<Nan> (not-a-number) floating point values can carry +payload information in addition to just being NaN. The amount of +information is limited, and dependent on the platform. +Either the payload overflowed, or simply could not be parsed. +See L<perldata/Special floating point>. + =item Invalid negative number (%s) in chr (W utf8) You passed a negative number to C<chr>. Negative numbers are diff --git a/t/op/infnan.t b/t/op/infnan.t index e3cd7c9..4670398 100644 --- a/t/op/infnan.t +++ b/t/op/infnan.t @@ -482,15 +482,30 @@ cmp_ok('-1e-9999', '==', 0, "underflow to 0 (runtime) from neg"); [ "nanxy", 1, $NaN ], [ "nan34", 1, $NaN ], [ "nan0x34", 1, $NaN ], + [ "nan 34", 1, $NaN ], + [ "nan 0x34", 1, $NaN ], [ "nanq", 0, $NaN ], # [ "nans", 0, $NaN, $PInf ], # Odd but valid. [ "nanx", 1, $NaN ], [ "nanqy", 1, $NaN ], + [ "nanxy", 1, $NaN ], [ "nan(123)", 0, $NaN ], + [ "nan(123)xy", 1, $NaN ], [ "nan(0x123)", 0, $NaN ], [ "nan(123xy)", 1, $NaN ], + [ "nan(123x)y", 1, $NaN ], + [ "nan(1)(2)", 1, $NaN ], + [ "nan(1xy2)", 1, $NaN ], + [ "nan(1)x(2)", 1, $NaN ], + [ "nan(1)x(2)", 1, $NaN ], + [ "nan(1)x(2)y", 1, $NaN ], [ "nan(0x123xy)", 1, $NaN ], [ "nanq(123)", 0, $NaN ], + [ "nanx(123)", 1, $NaN ], + [ "nanx(123)y", 1, $NaN ], + [ "nanx(123y)", 1, $NaN ], + [ "nanx(123y)z", 1, $NaN ], + [ "nan(123", 1, $NaN ], [ "1.#NANQ", 0, $NaN ], [ "1.#QNAN", 0, $NaN ], [ "1.#NANQx", 1, $NaN ], @@ -501,6 +516,7 @@ cmp_ok('-1e-9999', '==', 0, "underflow to 0 (runtime) from neg"); [ " nan", 0, $NaN ], [ "nan ", 0, $NaN ], [ " nan ", 0, $NaN ], + [ " nan(123) ", 1, $NaN ], ]; for my $t (@$T) { -- Perl5 Master Repository
