[m-rev.] diff: fix string.format with special float values in non-C grades

Julien Fischer jfischer at opturion.com
Mon Jun 30 14:40:00 AEST 2014


Branches: master, 14.01

----------------------

Fix string.format with special float values in non-C grades.

The Mercury implementation of string formatting used by the non-C grades did
not handle the various special float values (i.e. nan, inf and -inf) correctly.
For example, nan was with the '%f' conversion specifier was being formatted as
"nan.0".  Similarly, for -inf and inf.

library/string.m:
 	In the Mercury implementation of string formatting handle special
 	float values correctly.  (We format them as per C99.)

tests/general/string_format_special_floats.{m,exp}:
 	Extend this test to cover the capitalized versions of the float
 	conversion specifiers.

 	Update the formatting of this module.
NEWS:
 	Announce the above fix.

Julien.

diff --git a/NEWS b/NEWS
index aeb78a3..45de13b 100644
--- a/NEWS
+++ b/NEWS
@@ -21,6 +21,8 @@ This is a bug-fix release.
  * A problem that caused string.format/[23] to sometimes return incorrect
    results when formatting floats with the 'g' conversion specifier has
    been fixed.  This bug only affected the non-C backends.  (Bug #342)
+* string.format now handles special float values (i.e. nan, inf,  and -inf)
+  correctly with the non-C backends.

  Changes to the Mercury compiler:

diff --git a/library/string.m b/library/string.m
index 5e64562..8105036 100644
--- a/library/string.m
+++ b/library/string.m
@@ -2849,6 +2849,12 @@ prec(Prec, !PolyTypes, !Chars) :-
              % specifier representing "%%"
      ;       percent.

+    % Is the spec a capital letter?
+    %
+:- type spec_case
+    --->    spec_is_capital
+    ;       spec_is_not_capital.
+
      % Do we have a valid conversion specifier?
      % We check to ensure that the specifier also matches the type
      % from the input list.
@@ -2992,8 +2998,8 @@ specifier_to_string(spec_conv(Flags, Width, Prec, Spec)) = String :-
              FormatStr = make_format(Flags, Width, Prec, "", "e"),
              String = native_format_float(FormatStr, Float)
          ;
-            String = format_scientific_number(Flags, conv(Width), conv(Prec),
-                Float, "e")
+            String = format_scientific_number(Flags, spec_is_not_capital,
+                conv(Width), conv(Prec), Float, "e")
          )
      ;
          Spec = cE(Float),
@@ -3001,8 +3007,8 @@ specifier_to_string(spec_conv(Flags, Width, Prec, Spec)) = String :-
              FormatStr = make_format(Flags, Width, Prec, "", "E"),
              String = native_format_float(FormatStr, Float)
          ;
-            String = format_scientific_number(Flags, conv(Width), conv(Prec),
-                Float, "E")
+            String = format_scientific_number(Flags, spec_is_capital,
+                conv(Width), conv(Prec), Float, "E")
          )
      ;
          Spec = f(Float),
@@ -3010,7 +3016,8 @@ specifier_to_string(spec_conv(Flags, Width, Prec, Spec)) = String :-
              FormatStr = make_format(Flags, Width, Prec, "", "f"),
              String = native_format_float(FormatStr, Float)
          ;
-            String = format_float(Flags, conv(Width), conv(Prec), Float)
+            String = format_float(Flags, spec_is_not_capital, conv(Width),
+                conv(Prec), Float)
          )
      ;
          Spec = cF(Float),
@@ -3018,7 +3025,8 @@ specifier_to_string(spec_conv(Flags, Width, Prec, Spec)) = String :-
              FormatStr = make_format(Flags, Width, Prec, "", "F"),
              String = native_format_float(FormatStr, Float)
          ;
-            String = format_float(Flags, conv(Width), conv(Prec), Float)
+            String = format_float(Flags, spec_is_capital, conv(Width),
+                conv(Prec), Float)
          )
      ;
          Spec = g(Float),
@@ -3026,8 +3034,8 @@ specifier_to_string(spec_conv(Flags, Width, Prec, Spec)) = String :-
              FormatStr = make_format(Flags, Width, Prec, "", "g"),
              String = native_format_float(FormatStr, Float)
          ;
-            String = format_scientific_number_g(Flags, conv(Width), conv(Prec),
-                Float, "e")
+            String = format_scientific_number_g(Flags, spec_is_not_capital,
+                conv(Width), conv(Prec), Float, "e")
          )
      ;
          Spec = cG(Float),
@@ -3035,8 +3043,8 @@ specifier_to_string(spec_conv(Flags, Width, Prec, Spec)) = String :-
              FormatStr = make_format(Flags, Width, Prec, "", "G"),
              String = native_format_float(FormatStr, Float)
          ;
-            String = format_scientific_number_g(Flags, conv(Width), conv(Prec),
-                Float, "E")
+            String = format_scientific_number_g(Flags, spec_is_capital,
+                conv(Width), conv(Prec), Float, "E")
          )
      ;
          % Valid char conversion Specifiers.
@@ -3489,152 +3497,172 @@ format_unsigned_int(Flags, Width, Prec, Base, Int, IsTypeP, Prefix) = String :-

      % Format a float (f)
      %
-:- func format_float(flags, maybe_width, maybe_precision, float) = string.
-
-format_float(Flags, Width, Prec, Float) = NewFloat :-
-    % Determine absolute value of string.
-    Abs = abs(Float),
-
-    % Change precision (default is 6).
-    AbsStr = convert_float_to_string(Abs),
-    ( is_nan_or_inf(Abs) ->
-        PrecModStr = AbsStr
-    ;
-        (
-            Prec = yes(Precision),
-            PrecStr = change_precision(Precision, AbsStr)
+:- func format_float(flags, spec_case, maybe_width, maybe_precision, float)
+    = string.
+
+format_float(Flags, SpecCase, Width, Prec, Float) = NewFloat :-
+    ( is_nan(Float) ->
+        SignedStr = format_nan(SpecCase)
+    ; is_inf(Float) ->
+        SignedStr = format_inf(Float, SpecCase)
+    ; 
+        % Determine absolute value of string.
+        Abs = abs(Float),
+
+        % Change precision (default is 6).
+        AbsStr = convert_float_to_string(Abs),
+        ( is_nan_or_inf(Abs) ->
+            PrecModStr = AbsStr
          ;
-            Prec = no,
-            PrecStr = change_precision(6, AbsStr)
+            (
+                Prec = yes(Precision),
+                PrecStr = change_precision(Precision, AbsStr)
+            ;
+                Prec = no,
+                PrecStr = change_precision(6, AbsStr)
+            ),
+
+            % Do we need to remove the decimal point?
+            (
+                \+ member('#', Flags),
+                Prec = yes(0)
+            ->
+                PrecStrLen = string.count_codepoints(PrecStr),
+                PrecModStr = string.between(PrecStr, 0, PrecStrLen - 1)
+            ;
+                PrecModStr = PrecStr
+            )
          ),

-        % Do we need to remove the decimal point?
+        % Do we need to change field width?
          (
-            \+ member('#', Flags),
-            Prec = yes(0)
+            Width = yes(FieldWidth),
+            FieldWidth > string.count_codepoints(PrecModStr),
+            member('0', Flags),
+            \+ member('-', Flags)
          ->
-            PrecStrLen = string.count_codepoints(PrecStr),
-            PrecModStr = string.between(PrecStr, 0, PrecStrLen - 1)
+            FieldStr = string.pad_left(PrecModStr, '0', FieldWidth - 1),
+            ZeroPadded = yes
          ;
-            PrecModStr = PrecStr
-        )
-    ),
-
-    % Do we need to change field width?
-    (
-        Width = yes(FieldWidth),
-        FieldWidth > string.count_codepoints(PrecModStr),
-        member('0', Flags),
-        \+ member('-', Flags)
-    ->
-        FieldStr = string.pad_left(PrecModStr, '0', FieldWidth - 1),
-        ZeroPadded = yes
-    ;
-        FieldStr = PrecModStr,
-        ZeroPadded = no
+            FieldStr = PrecModStr,
+            ZeroPadded = no
+        ),
+        % Finishing up ..
+        SignedStr = add_float_prefix_if_needed(Flags, ZeroPadded, Float, FieldStr)
      ),
-    % Finishing up ..
-    SignedStr = add_float_prefix_if_needed(Flags, ZeroPadded, Float, FieldStr),
      NewFloat = justify_string(Flags, Width, SignedStr).

      % Format a scientific number to a specified number of significant
      % figures (g,G)
      %
-:- func format_scientific_number_g(flags, maybe_width, maybe_precision,
-    float, string) = string.
-
-format_scientific_number_g(Flags, Width, Prec, Float, E) = NewFloat :-
-    % Determine absolute value of string.
-    Abs = abs(Float),
-
-    % Change precision (default is 6).
-    AbsStr = convert_float_to_string(Abs),
-    ( is_nan_or_inf(Abs) ->
-        PrecStr = AbsStr
-    ;
-        (
-            Prec = yes(Precision),
-            ( Precision = 0 ->
-                PrecStr = change_to_g_notation(AbsStr, 1, E, Flags)
+:- func format_scientific_number_g(flags, spec_case, maybe_width,
+    maybe_precision, float, string) = string.
+
+format_scientific_number_g(Flags, SpecCase, Width, Prec, Float, E)
+        = NewFloat :-
+    ( is_nan(Float) ->
+        SignedStr = format_nan(SpecCase)
+    ; is_inf(Float) ->
+        SignedStr = format_inf(Float, SpecCase)
+    ; 
+        % Determine absolute value of string.
+        Abs = abs(Float),
+
+        % Change precision (default is 6).
+        AbsStr = convert_float_to_string(Abs),
+        ( is_nan_or_inf(Abs) ->
+            PrecStr = AbsStr
+        ;
+            (
+                Prec = yes(Precision),
+                ( Precision = 0 ->
+                    PrecStr = change_to_g_notation(AbsStr, 1, E, Flags)
+                ;
+                    PrecStr = change_to_g_notation(AbsStr, Precision, E, Flags)
+                )
              ;
-                PrecStr = change_to_g_notation(AbsStr, Precision, E, Flags)
+                Prec = no,
+                PrecStr = change_to_g_notation(AbsStr, 6, E, Flags)
              )
+        ),
+
+            %
+            % Do we need to change field width?
+            %
+        (
+            Width = yes(FieldWidth),
+            FieldWidth > string.count_codepoints(PrecStr),
+            member('0', Flags),
+            \+ member('-', Flags)
+        ->
+            FieldStr = string.pad_left(PrecStr, '0', FieldWidth - 1),
+            ZeroPadded = yes
          ;
-            Prec = no,
-            PrecStr = change_to_g_notation(AbsStr, 6, E, Flags)
-        )
-    ),
+            FieldStr = PrecStr,
+            ZeroPadded = no
+        ),

-        %
-        % Do we need to change field width?
-        %
-    (
-        Width = yes(FieldWidth),
-        FieldWidth > string.count_codepoints(PrecStr),
-        member('0', Flags),
-        \+ member('-', Flags)
-    ->
-        FieldStr = string.pad_left(PrecStr, '0', FieldWidth - 1),
-        ZeroPadded = yes
-    ;
-        FieldStr = PrecStr,
-        ZeroPadded = no
+        % Finishing up ..
+        SignedStr = add_float_prefix_if_needed(Flags, ZeroPadded, Float, FieldStr)
      ),
-
-    % Finishing up ..
-    SignedStr = add_float_prefix_if_needed(Flags, ZeroPadded, Float, FieldStr),
      NewFloat = justify_string(Flags, Width, SignedStr).

      % Format a scientific number (e,E)
      %
-:- func format_scientific_number(flags, maybe_width, maybe_precision,
-    float, string) = string.
-
-format_scientific_number(Flags, Width, Prec, Float, E) = NewFloat :-
-    % Determine absolute value of string.
-    Abs = abs(Float),
-
-    % Change precision (default is 6).
-    AbsStr = convert_float_to_string(Abs),
-    ( is_nan_or_inf(Abs) ->
-        PrecModStr = AbsStr
-    ;
-        (
-            Prec = yes(Precision),
-            PrecStr = change_to_e_notation(AbsStr, Precision, E)
+:- func format_scientific_number(flags, spec_case, maybe_width,
+    maybe_precision, float, string) = string.
+
+format_scientific_number(Flags, SpecCase, Width, Prec, Float, E) = NewFloat :-
+    ( is_nan(Float) ->
+        SignedStr = format_nan(SpecCase)
+    ; is_inf(Float) ->
+        SignedStr = format_inf(Float, SpecCase)
+    ; 
+        % Determine absolute value of string.
+        Abs = abs(Float),
+
+        % Change precision (default is 6).
+        AbsStr = convert_float_to_string(Abs),
+        ( is_nan_or_inf(Abs) ->
+            PrecModStr = AbsStr
          ;
-            Prec = no,
-            PrecStr = change_to_e_notation(AbsStr, 6, E)
+            (
+                Prec = yes(Precision),
+                PrecStr = change_to_e_notation(AbsStr, Precision, E)
+            ;
+                Prec = no,
+                PrecStr = change_to_e_notation(AbsStr, 6, E)
+            ),
+
+            % Do we need to remove the decimal point?
+            (
+                \+ member('#', Flags),
+                Prec = yes(0)
+            ->
+                split_at_decimal_point(PrecStr, BaseStr, ExponentStr),
+                PrecModStr = BaseStr ++ ExponentStr
+            ;
+                PrecModStr = PrecStr
+            )
          ),

-        % Do we need to remove the decimal point?
+        % Do we need to change field width?
          (
-            \+ member('#', Flags),
-            Prec = yes(0)
+            Width = yes(FieldWidth),
+            FieldWidth > string.count_codepoints(PrecModStr),
+            member('0', Flags),
+            \+ member('-', Flags)
          ->
-            split_at_decimal_point(PrecStr, BaseStr, ExponentStr),
-            PrecModStr = BaseStr ++ ExponentStr
+            FieldStr = string.pad_left(PrecModStr, '0', FieldWidth - 1),
+            ZeroPadded = yes
          ;
-            PrecModStr = PrecStr
-        )
-    ),
+            FieldStr = PrecModStr,
+            ZeroPadded = no
+        ),

-    % Do we need to change field width?
-    (
-        Width = yes(FieldWidth),
-        FieldWidth > string.count_codepoints(PrecModStr),
-        member('0', Flags),
-        \+ member('-', Flags)
-    ->
-        FieldStr = string.pad_left(PrecModStr, '0', FieldWidth - 1),
-        ZeroPadded = yes
-    ;
-        FieldStr = PrecModStr,
-        ZeroPadded = no
+        % Finishing up ..
+        SignedStr = add_float_prefix_if_needed(Flags, ZeroPadded, Float, FieldStr)
      ),
-
-    % Finishing up ..
-    SignedStr = add_float_prefix_if_needed(Flags, ZeroPadded, Float, FieldStr),
      NewFloat = justify_string(Flags, Width, SignedStr).

  :- func add_int_prefix_if_needed(flags, bool, int, string) = string.
@@ -3781,6 +3809,9 @@ get_capital_hex_int(Int) = HexStr :-
      % This predicate relies on the fact that string.float_to_string returns
      % a float which is round-trippable, ie to the full precision needed.
      %
+    % NOTE: this function does *not* handle special float values, like NaN
+    % and Infinity.
+    %
  :- func convert_float_to_string(float) = string.

  convert_float_to_string(Float) = String :-
@@ -4122,6 +4153,22 @@ is_decimal_point('.').
  is_exponent('e').
  is_exponent('E').

+:- func format_nan(spec_case) = string.
+
+format_nan(spec_is_capital) = "NAN".
+format_nan(spec_is_not_capital) = "nan".
+
+:- func format_inf(float, spec_case) = string.
+
+format_inf(F, SpecCase) = String :-
+    (
+        SpecCase = spec_is_capital,
+        String = ( if F < 0.0 then "-INF" else "INF" )
+    ;
+        SpecCase = spec_is_not_capital,
+        String = ( if F < 0.0 then "-inf" else "inf" )
+    ).
+
  %-----------------------------------------------------------------------------%

  % The remaining routines are implemented using the C interface.
diff --git a/tests/general/string_format_special_floats.exp b/tests/general/string_format_special_floats.exp
index 16dcf91..640718a 100644
--- a/tests/general/string_format_special_floats.exp
+++ b/tests/general/string_format_special_floats.exp
@@ -2,11 +2,20 @@ Plus Infinity:
                    %e: success
                    %f: success
                    %g: success
+                  %E: success
+                  %F: success
+                  %G: success
  Minus Infinity:
                    %e: success
                    %f: success
                    %g: success
+                  %E: success
+                  %F: success
+                  %G: success
  Not a number:
                    %e: success
                    %f: success
                    %g: success
+                  %E: success
+                  %F: success
+                  %G: success
diff --git a/tests/general/string_format_special_floats.m b/tests/general/string_format_special_floats.m
index 0aad54e..e9d89ef 100644
--- a/tests/general/string_format_special_floats.m
+++ b/tests/general/string_format_special_floats.m
@@ -1,12 +1,11 @@
  %------------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
  %------------------------------------------------------------------------------%

  :- module string_format_special_floats.
-
  :- interface.

  :- import_module io.
-
  :- pred main(io::di, io::uo) is det.

  %------------------------------------------------------------------------------%
@@ -14,68 +13,69 @@

  :- implementation.

-:- import_module float, list, string.
+:- import_module float.
+:- import_module list.
+:- import_module string.

  %------------------------------------------------------------------------------%

-main -->
-	{ Inf = (max+max) },
-	io__write_string("Plus Infinity:\n"),
-	list__foldl(test_floats(is_plus_infinity, [Inf]), ["%e", "%f", "%g"]),
-	io__write_string("Minus Infinity:\n"),
-	list__foldl(test_floats(is_minus_infinity, [-Inf]),
-		["%e", "%f", "%g"]),
-	io__write_string("Not a number:\n"),
-	list__foldl(test_floats(is_nan, [0.0 * Inf]), ["%e", "%f", "%g"]).
+main(!IO) :-
+    Inf = (max + max),
+    TestSpecs = ["%e", "%f", "%g", "%E", "%F", "%G"],
+    io.write_string("Plus Infinity:\n", !IO),
+    list.foldl(test_floats(is_plus_infinity, [Inf]), TestSpecs, !IO),
+    io.write_string("Minus Infinity:\n", !IO),
+    list.foldl(test_floats(is_minus_infinity, [-Inf]), TestSpecs, !IO),
+    io.write_string("Not a number:\n", !IO),
+    list.foldl(test_floats(is_nan, [0.0 * Inf]), TestSpecs, !IO).

  :- pred test_floats(pred(string)::in(pred(in) is semidet), list(float)::in,
-		string::in, io::di, io::uo) is det.
-
-test_floats(IsValid, Floats, FormatString) -->
-	list__foldl(test_float(FormatString, IsValid), Floats).
+    string::in, io::di, io::uo) is det.

+test_floats(IsValid, Floats, FormatString, !IO) :-
+    list.foldl(test_float(FormatString, IsValid), Floats, !IO).

  :- pred test_float(string::in, pred(string)::in(pred(in) is semidet),
-		float::in, io::di, io::uo) is det.
+    float::in, io::di, io::uo) is det.

-test_float(FormatString, IsValid, Float) -->
-	{ FloatString = string__format(FormatString, [f(Float)]) },
-	io__format("%20s: ", [s(FormatString)]),
-	( { IsValid(FloatString) }->
-		io__write_string("success\n")
-	;
-		io__write_string("failure '" ++ FloatString ++ "'\n")
-	).
+test_float(FormatString, IsValid, Float, !IO) :-
+    FloatString = string.format(FormatString, [f(Float)]),
+    io.format("%20s: ", [s(FormatString)], !IO),
+    ( IsValid(FloatString) ->
+        io.write_string("success\n", !IO)
+    ;
+        io.write_string("failure '" ++ FloatString ++ "'\n", !IO)
+    ).

  :- pred is_plus_infinity(string::in) is semidet.

  is_plus_infinity(String) :-
-	LowerCaseString = string__to_lower(String),
-	( LowerCaseString = "infinity"
-	; LowerCaseString = "inf"
-	).
+    LowerCaseString = string.to_lower(String),
+    ( LowerCaseString = "infinity"
+    ; LowerCaseString = "inf"
+    ).

  :- pred is_minus_infinity(string::in) is semidet.

  is_minus_infinity(String) :-
-	LowerCaseString = string__to_lower(String),
-	( LowerCaseString = "-infinity"
-	; LowerCaseString = "-inf"
-	).
+    LowerCaseString = string.to_lower(String),
+    ( LowerCaseString = "-infinity"
+    ; LowerCaseString = "-inf"
+    ).

  :- pred is_nan(string::in) is semidet.

  is_nan(String) :-
-	LowerCaseString = string__to_lower(String),
-	( LowerCaseString = "nan"
-	% XXX Actually, it makes no sense to put a minus sign on a NaN,
-	%     since NaNs aren't signed.  However, the printf() function in
-	%     some C libraries (in particular, the one for Solaris 2.7)
-	%     do that.  Arguably that's a bug, but we can't do much about
-	%     bugs in the Solaris C library, so we don't want to report a
-	%     test case failure for that.  Hence we allow -NaN here.
-	; LowerCaseString = "-nan"
-	).
+    LowerCaseString = string.to_lower(String),
+    ( LowerCaseString = "nan"
+    % XXX Actually, it makes no sense to put a minus sign on a NaN,
+    %     since NaNs aren't signed.  However, the printf() function in
+    %     some C libraries (in particular, the one for Solaris 2.7)
+    %     do that.  Arguably that's a bug, but we can't do much about
+    %     bugs in the Solaris C library, so we don't want to report a
+    %     test case failure for that.  Hence we allow -NaN here.
+    ; LowerCaseString = "-nan"
+    ).

  %------------------------------------------------------------------------------%
  %------------------------------------------------------------------------------%




More information about the reviews mailing list