[core] Fix sprintf width for NaN/Inf/-Inf [GH #1099]

Add the missing width handling, and add tests.
for perl6 RT 116280, from Raku/roast@2647c16652

ChangeLog

@@ -12,6 +12,7 @@
 	+ Enable >2GB RAM on darwin also [GH #268]
 	+ Fix crash with parrot -d8 DEBUG_IMC dump_instructions
 	+ Fix sprintf width count for unicode strings [GH #956]
+	+ Fix sprintf width for NaN/Inf/-Inf [GH #1099/perl6 RT#116280]
 	+ Optimize utf8_substr. Do not use the slow utf8 iterator.
     - Build
 	+ Fix all -Wshadow instances

src/string/spf_render.c

@@ -826,23 +826,27 @@ Parrot_sprintf_format(PARROT_INTERP, ARGIN(const STRING *pat), ARGMOD(SPRINTF_OB
                   case 'g':
                   case 'G':
                     {
-                        STRING *ts;
+                        STRING *ts = NULL;
                         const HUGEFLOATVAL thefloat =
                             obj->getfloat(interp, info.type, obj);
+                        int is_special = 0;
 
-                        /* check for Inf and NaN values */
+                        gen_sprintf_call(tc, &info, ch);
+                        /* check for Inf and NaN values and honor width, but not prec */
                         if (PARROT_FLOATVAL_IS_POSINF(thefloat)) {
                             ts = cstr2pstr(PARROT_CSTRING_INF_POSITIVE);
+                            is_special++;
                         }
                         else if (PARROT_FLOATVAL_IS_NEGINF(thefloat)) {
                             ts = cstr2pstr(PARROT_CSTRING_INF_NEGATIVE);
+                            is_special++;
                         }
                         else if (PARROT_FLOATVAL_IS_NAN(thefloat)) {
                             ts = cstr2pstr(PARROT_CSTRING_NAN_QUIET);
+                            is_special++;
                         }
                         else {
                             /* turn -0.0 into 0.0 */
-                            gen_sprintf_call(tc, &info, ch);
                             ts = cstr2pstr(tc);
                         }
 
@@ -851,13 +855,28 @@ Parrot_sprintf_format(PARROT_INTERP, ARGIN(const STRING *pat), ARGMOD(SPRINTF_OB
                             char * const tempstr =
                                 Parrot_str_to_cstring(interp, ts);
 
+                            /* Apply width to NaN/Inf/-Inf [GH #1100/perl6 RT#116280]
+                               Don't rely on how systems print nan. */
+                            if (is_special && info.width != 0) {
+                                char tc1[16];
 #ifdef PARROT_HAS_SNPRINTF
-                            snprintf(tc, PARROT_SPRINTF_BUFFER_SIZE,
-                                     tempstr, (double)thefloat);
+                                snprintf(tc1, 16, "%%%ds", info.width);
+                                snprintf(tc, PARROT_SPRINTF_BUFFER_SIZE,
+                                         tc1, tempstr);
 #else
-                            /* the buffer is 4096, so no problem here */
-                            sprintf(tc, tempstr, (double)thefloat);
+                                sprintf(tc1, "%%%ds", info.width);
+                                sprintf(tc, tc1, tempstr);
+#endif
+                            }
+                            else {
+#ifdef PARROT_HAS_SNPRINTF
+                                snprintf(tc, PARROT_SPRINTF_BUFFER_SIZE,
+                                         tempstr, (double)thefloat);
+#else
+                                /* the buffer is 4096, so no problem here */
+                                sprintf(tc, tempstr, (double)thefloat);
 #endif
+                            }
                             Parrot_str_free_cstring(tempstr);
                         }
 

t/op/sprintf.t

@@ -1,5 +1,5 @@
 #!./parrot
-# Copyright (C) 2006-2010, Parrot Foundation.
+# Copyright (C) 2006-2014, Parrot Foundation.
 
 =head1 NAME
 
@@ -11,7 +11,8 @@ t/op/sprintf.t  -- sprintf tests
 
 =head1 DESCRIPTION
 
-These tests are based on C<sprintf> tests from perl 5.9.4.
+These tests are based on C<sprintf> tests from perl 5.9.4
+with additional tests from perl6 F<S32-str/sprintf.t>
 
 Tests C<sprintf>, excluding handling of 64-bit integers or long
 doubles (if supported), of machine-specific short and long
@@ -56,7 +57,7 @@ tag C<all> is allowed for todo tests that should fail on any system.
 =cut
 
 
-.const int TESTS = 308
+.const int TESTS = 311
 
 #.loadlib 'sys_ops'
 #.loadlib 'io_ops'

t/op/sprintf_tests

@@ -307,5 +307,8 @@
 %#x	0	0
 %2147483647$v2d	''	
 %*2147483647$v2d	''	 UNINIT
+"%12.5f"	NaN	"         NaN"	perl6 RT 116280
+"%12.5f"	Inf	"         Inf"	perl6 RT 116280
+"%12.5f"	-Inf	"        -Inf"	perl6 RT 116280
 
 # vim: sw=4 et