In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/44a465b3a06ab1f2660624ca7a8a125c739a587b?hp=465068b9603c2b45dd30f79c0d4dd3ae6c1e9ef0>
- Log ----------------------------------------------------------------- commit 44a465b3a06ab1f2660624ca7a8a125c739a587b Author: Jarkko Hietaniemi <[email protected]> Date: Mon Jan 19 21:52:13 2015 +0100 Mention some curious cases of ** M pod/perlop.pod commit 7b5f862a8b6cc59b1bbb7a50d05b8c38fefbe1ca Author: Jarkko Hietaniemi <[email protected]> Date: Mon Jan 19 23:10:48 2015 +0100 Notes on NaN structure, for future generation/extraction. M ext/POSIX/POSIX.xs commit 6b3224243486327c12d1c60f57030dfc0335bb40 Author: Jarkko Hietaniemi <[email protected]> Date: Mon Jan 19 21:39:05 2015 +0100 Make numifying "nanblah" warn, just like "345blah" does. M sv.c M t/op/infnan.t commit 5d801ef3b17149a9d7b9c7dbebfd966508504e1f Author: Jarkko Hietaniemi <[email protected]> Date: Mon Jan 19 21:15:58 2015 +0100 infnan: sprintf width and left-align. M sv.c M t/op/infnan.t commit c1554ae1efab39347568803190c37f1ee3df14cb Author: Jarkko Hietaniemi <[email protected]> Date: Mon Jan 19 20:01:42 2015 +0100 Clarify test messages. M t/op/infnan.t commit 63d7924f9388b3d573de3f77fdbbdd4c0f5039dd Author: Karl Williamson <[email protected]> Date: Tue Jan 20 08:33:56 2015 -0700 Porting/checkAUTHORS.pl: New alternate addr for jhi M Porting/checkAUTHORS.pl ----------------------------------------------------------------------- Summary of changes: Porting/checkAUTHORS.pl | 1 + ext/POSIX/POSIX.xs | 35 +++++++++++++++++++++++++++++++ pod/perlop.pod | 5 +++++ sv.c | 31 ++++++++++++++++++++++----- t/op/infnan.t | 56 +++++++++++++++++++++++++++++++++++++++++++------ 5 files changed, 117 insertions(+), 11 deletions(-) diff --git a/Porting/checkAUTHORS.pl b/Porting/checkAUTHORS.pl index 3b799f5..34dbc00 100755 --- a/Porting/checkAUTHORS.pl +++ b/Porting/checkAUTHORS.pl @@ -443,6 +443,7 @@ jhi jhi\100iki.fi + jhi\100hut.fi + jarkko.hietaniemi\100nokia.com + jarkko.hietaniemi\100cc.hut.fi ++ jarkko.hietaniemi\100booking.com jesse jesse\100bestpractical.com + jesse\100fsck.com + jesse\100perl.org diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index 8f9a50c..261fa34 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -2649,6 +2649,41 @@ nan(s = 0) #elif defined(NV_NAN) /* XXX if s != NULL, warn about unused argument, * or implement the nan payload setting. */ + /* NVSIZE == 8: the NaN "header" (the exponent) is 0x7FF (the 0x800 + * is the sign bit, which should be irrelevant for NaN, so really + * also 0xFFF), leaving 64 - 12 = 52 bits for the NaN payload + * (6.5 bytes, note about infinities below). + * + * (USE_LONG_DOUBLE and) + * LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN: + * the NaN "header" is still 0x7FF, leaving 80 - 12 = 68 bits + * for the payload (8.5 bytes, note about infinities below). + * + * doubledouble? aargh. Maybe like doubles, 52 + 52 = 104 bits? + * + * NVSIZE == 16: + * the NaN "header" is still 0x7FF, leaving 128 - 12 = 116 bits + * for the payload (14.5 bytes, note about infinities below) + * + * Which ones of the NaNs are 'signaling' and which are 'quiet', + * depends. In the IEEE-754 1985, nothing was specified. But the + * majority of companies decided that the MSB of the mantissa was + * the bit for 'quiet'. (Only PA-RISC and MIPS were different, + * using the MSB as 'signaling'.) The IEEE-754 2008 *recommended* + * (but did not dictate) the MSB as the 'quiet' bit. + * + * In other words, on most platforms, and for 64-bit doubles: + * [7FF8000000000000, 7FFFFFFFFFFFFFFF] quiet + * [FFF8000000000000, FFFFFFFFFFFFFFFF] quiet + * [7FF0000000000001, 7FF7FFFFFFFFFFFF] signaling + * [FFF0000000000001, FFF7FFFFFFFFFFFF] signaling + * + * The C99 nan() is supposed to generate *quiet* NaNs. + * + * Note the asymmetry: + * The 7FF0000000000000 is positive infinity, + * the FFF0000000000000 is negative infinity. + */ RETVAL = NV_NAN; #else not_here("nan"); diff --git a/pod/perlop.pod b/pod/perlop.pod index d4b0cd1..dc546fb 100644 --- a/pod/perlop.pod +++ b/pod/perlop.pod @@ -207,6 +207,11 @@ tightly than unary minus, so -2**4 is -(2**4), not (-2)**4. (This is implemented using C's pow(3) function, which actually works on doubles internally.) +Note that certain exponentiation expressions are ill-defined: +these include C<0**0>, C<1**Inf>, and C<Inf**0>. Do not expect +any particular results from these special cases, the results +are platform-dependent. + =head2 Symbolic Unary Operators X<unary operator> X<operator, unary> diff --git a/sv.c b/sv.c index 649c7e1..db29380 100644 --- a/sv.c +++ b/sv.c @@ -2249,6 +2249,8 @@ S_sv_2iuv_common(pTHX_ SV *const sv) sv_upgrade(sv, SVt_PVNV); if ((numtype & (IS_NUMBER_INFINITY | IS_NUMBER_NAN))) { + if (ckWARN(WARN_NUMERIC) && ((numtype & IS_NUMBER_NAN))) + not_a_number(sv); S_sv_setnv(aTHX_ sv, numtype); return FALSE; } @@ -2892,7 +2894,7 @@ S_uiv_2buf(char *const buf, const IV iv, UV uv, const int is_uv, char **const pe * shared string constants we point to, instead of generating a new * string for each instance. */ STATIC size_t -S_infnan_2pv(NV nv, char* buffer, size_t maxlen) { +S_infnan_2pv(NV nv, char* buffer, size_t maxlen, char plus) { assert(maxlen >= 4); if (maxlen < 4) /* "Inf\0", "NaN\0" */ return 0; @@ -2903,6 +2905,8 @@ S_infnan_2pv(NV nv, char* buffer, size_t maxlen) { if (maxlen < 5) /* "-Inf\0" */ return 0; *s++ = '-'; + } else if (plus) { + *s++ = '+'; } *s++ = 'I'; *s++ = 'n'; @@ -3117,7 +3121,7 @@ Perl_sv_2pv_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags) STRLEN size = 5; /* "-Inf\0" */ s = SvGROW_mutable(sv, size); - len = S_infnan_2pv(SvNVX(sv), s, size); + len = S_infnan_2pv(SvNVX(sv), s, size, 0); if (len > 0) { s += len; SvPOK_on(sv); @@ -10778,7 +10782,7 @@ S_F0convert(NV nv, char *const endbuf, STRLEN *const len) PERL_ARGS_ASSERT_F0CONVERT; if (UNLIKELY(Perl_isinfnan(nv))) { - STRLEN n = S_infnan_2pv(nv, endbuf - *len, *len); + STRLEN n = S_infnan_2pv(nv, endbuf - *len, *len, 0); *len = n; return endbuf - n; } @@ -12472,8 +12476,25 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p elen = width; } } - else - elen = S_infnan_2pv(fv, PL_efloatbuf, PL_efloatsize); + else { + elen = S_infnan_2pv(fv, PL_efloatbuf, PL_efloatsize, plus); + if (elen) { + /* Not affecting infnan output: precision, alt, fill. */ + if (elen < width) { + if (left) { + /* Pack the back with spaces. */ + memset(PL_efloatbuf + elen, ' ', width - elen); + } else { + /* Move it to the right. */ + Move(PL_efloatbuf, PL_efloatbuf + width - elen, + elen, char); + /* Pad the front with spaces. */ + memset(PL_efloatbuf, ' ', width - elen); + } + elen = width; + } + } + } if (elen == 0) { char *ptr = ebuf + sizeof ebuf; diff --git a/t/op/infnan.t b/t/op/infnan.t index bb03fd4..ef8ee4b 100644 --- a/t/op/infnan.t +++ b/t/op/infnan.t @@ -20,7 +20,11 @@ BEGIN { my $PInf = "Inf" + 0; my $NInf = "-Inf" + 0; -my $NaN = "NaN" + 0; +my $NaN; +{ + local $^W = 0; # warning-ness tested later. + $NaN = "NaN" + 0; +} my @PInf = ("Inf", "inf", "INF", "+Inf", "Infinity", "INFINITE", @@ -81,11 +85,23 @@ for my $f (@printf_fmt) { is(sprintf("%$f", $PInf), "Inf", "$PInf sprintf %$f is Inf"); } +is(sprintf("%+g", $PInf), "+Inf", "$PInf sprintf %+g"); +is(sprintf("%+g", $NInf), "-Inf", "$PInf sprintf %+g"); + +is(sprintf("%4g", $PInf), " Inf", "$PInf sprintf %4g"); +is(sprintf("%-4g", $PInf), "Inf ", "$PInf sprintf %-4g"); + +is(sprintf("%+-5g", $PInf), "+Inf ", "$PInf sprintf %+-5g"); +is(sprintf("%-+5g", $PInf), "+Inf ", "$PInf sprintf %-+5g"); + +is(sprintf("%-+5g", $NInf), "-Inf ", "$NInf sprintf %-+5g"); +is(sprintf("%+-5g", $NInf), "-Inf ", "$NInf sprintf %+-5g"); + ok(!defined eval { $a = sprintf("%c", $PInf)}, "sprintf %c +Inf undef"); like($@, qr/Cannot printf/, "$PInf sprintf fails"); ok(!defined eval { $a = sprintf("%c", "Inf")}, "stringy sprintf %c +Inf undef"); -like($@, qr/Cannot printf/, "stringy $PInf sprintf fails"); +like($@, qr/Cannot printf/, "stringy $PInf sprintf %c fails"); ok(!defined eval { $a = chr($PInf) }, "chr(+Inf) undef"); like($@, qr/Cannot chr/, "+Inf chr() fails"); @@ -96,7 +112,7 @@ ok(!defined eval { $a = sprintf("%c", $NInf)}, "sprintf %c -Inf undef"); like($@, qr/Cannot printf/, "$NInf sprintf fails"); ok(!defined eval { $a = sprintf("%c", "-Inf")}, "sprintf %c stringy -Inf undef"); -like($@, qr/Cannot printf/, "stringy $NInf sprintf fails"); +like($@, qr/Cannot printf/, "stringy $NInf sprintf %c fails"); ok(!defined eval { $a = chr($NInf) }, "chr(-Inf) undef"); like($@, qr/Cannot chr/, "-Inf chr() fails"); @@ -263,8 +279,11 @@ ok($NaN eq $NaN, "NaN is NaN stringifically"); is("$NaN", "NaN", "$NaN value stringifies as NaN"); -is("+NaN" + 0, "NaN", "+NaN is NaN"); -is("-NaN" + 0, "NaN", "-NaN is NaN"); +{ + local $^W = 0; # warning-ness tested later. + is("+NaN" + 0, "NaN", "+NaN is NaN"); + is("-NaN" + 0, "NaN", "-NaN is NaN"); +} is($NaN + 0, $NaN, "NaN + zero is NaN"); @@ -280,11 +299,19 @@ for my $f (@printf_fmt) { is(sprintf("%$f", $NaN), "NaN", "$NaN sprintf %$f is NaN"); } +is(sprintf("%+g", $NaN), "NaN", "$NaN sprintf %+g"); + +is(sprintf("%4g", $NaN), " NaN", "$NaN sprintf %4g"); +is(sprintf("%-4g", $NaN), "NaN ", "$NaN sprintf %-4g"); + +is(sprintf("%+-5g", $NaN), "NaN ", "$NaN sprintf %+-5g"); +is(sprintf("%-+5g", $NaN), "NaN ", "$NaN sprintf %-+5g"); + ok(!defined eval { $a = sprintf("%c", $NaN)}, "sprintf %c NaN undef"); like($@, qr/Cannot printf/, "$NaN sprintf fails"); ok(!defined eval { $a = sprintf("%c", "NaN")}, "sprintf %c stringy NaN undef"); -like($@, qr/Cannot printf/, "stringy $NaN sprintf fails"); +like($@, qr/Cannot printf/, "stringy $NaN sprintf %c fails"); ok(!defined eval { $a = chr($NaN) }, "chr NaN undef"); like($@, qr/Cannot chr/, "NaN chr() fails"); @@ -316,6 +343,7 @@ is eval { unpack "p", pack 'p', $NaN }, "NaN", "pack p +NaN"; is eval { unpack "P3", pack 'P', $NaN }, "NaN", "pack P +NaN"; for my $i (@NaN) { + local $^W = 0; # warning-ness tested later. cmp_ok($i + 0, '!=', $i + 0, "$i is NaN numerically (by not being NaN)"); is("@{[$i+0]}", "NaN", "$i value stringifies as NaN"); } @@ -379,6 +407,22 @@ SKIP: { is("a" x $NaN, "", "x NaN"); } +{ + my $w; + local $SIG{__WARN__} = sub { $w = shift }; + local $^W = 1; + my $a; + eval '$a = "nancy" + 1'; + is($a, "$NaN", "nancy plus one is $NaN"); + like($w, qr/^Argument "nancy" isn't numeric/, "nancy numify (compile time)"); + + my $n = "nanana"; + my $b; + eval '$b = $n + 1'; + is($b, "$NaN", "$n plus one is $NaN"); + like($w, qr/^Argument "$n" isn't numeric/, "$n numify (runtime)"); +} + # === Tests combining Inf and NaN === # is() okay with $NaN because it uses eq. -- Perl5 Master Repository
