re PR libfortran/12839 (incorrect IO of Inf)

2004-06-12  Bud Davis  <bdavis9659@comcast.net>

        PR gfortran/12839
        * gfortran.fortran-torture/execute/nan_inf_fmt.f90: New test.
        * io/write.c(write_float): format inf and nan IAW F2003.

From-SVN: r83024

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 8fc34ba9d6840c3aca94c99c644cc1e067b7a10f..ec49a6676c860226526cb9099c069bfa02bfcc11 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2004-06-12  Bud Davis  <bdavis9659@comcast.net>
+
+       PR gfortran/12839
+       * gfortran.fortran-torture/execute/nan_inf_fmt.f90: New test.
+
 2004-06-11  Mark Mitchell  <mark@codesourcery.com>
 
        PR c++/15862

diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/nan_inf_fmt.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/nan_inf_fmt.f90
new file mode 100644 (file)
index 0000000..84322c6
--- /dev/null
+++ b/gcc/testsuite/gfortran.fortran-torture/execute/nan_inf_fmt.f90
@@ -0,0 +1,79 @@
+!pr 12839- F2003 formatting of Inf /Nan 
+       implicit none
+       character*40 l
+       character*12 fmt
+       real zero, pos_inf, neg_inf, nan
+       zero = 0.0
+
+! need a better way of generating these floating point
+! exceptional constants.
+
+       pos_inf =  1.0/zero
+       neg_inf = -1.0/zero
+       nan = zero/zero
+
+
+! check a field width < 3
+       fmt = '(F2.0)'
+       write(l,fmt=fmt)pos_inf
+       if (l.ne.'**') call abort
+       write(l,fmt=fmt)neg_inf
+       if (l.ne.'**') call abort
+       write(l,fmt=fmt)nan
+       if (l.ne.'**') call abort
+
+! check a field width = 3
+       fmt = '(F3.0)'
+       write(l,fmt=fmt)pos_inf
+       if (l.ne.'Inf') call abort
+       write(l,fmt=fmt)neg_inf
+       if (l.ne.'Inf') call abort
+       write(l,fmt=fmt)nan
+       if (l.ne.'NaN') call abort
+
+! check a field width > 3
+       fmt = '(F4.0)'
+       write(l,fmt=fmt)pos_inf
+       if (l.ne.'+Inf') call abort
+       write(l,fmt=fmt)neg_inf
+       if (l.ne.'-Inf') call abort
+       write(l,fmt=fmt)nan
+       if (l.ne.' NaN') call abort
+
+! check a field width = 7
+       fmt = '(F7.0)'
+       write(l,fmt=fmt)pos_inf
+       if (l.ne.'   +Inf') call abort
+       write(l,fmt=fmt)neg_inf
+       if (l.ne.'   -Inf') call abort
+       write(l,fmt=fmt)nan
+       if (l.ne.'    NaN') call abort
+
+! check a field width = 8
+       fmt = '(F8.0)'
+       write(l,fmt=fmt)pos_inf
+       if (l.ne.'Infinity') call abort
+       write(l,fmt=fmt)neg_inf
+       if (l.ne.'Infinity') call abort
+       write(l,fmt=fmt)nan
+       if (l.ne.'     NaN') call abort
+
+! check a field width = 9
+       fmt = '(F9.0)'
+       write(l,fmt=fmt)pos_inf
+       if (l.ne.'+Infinity') call abort
+       write(l,fmt=fmt)neg_inf
+       if (l.ne.'-Infinity') call abort
+       write(l,fmt=fmt)nan
+       if (l.ne.'      NaN') call abort
+
+! check a field width = 14
+       fmt = '(F14.0)'
+       write(l,fmt=fmt)pos_inf
+       if (l.ne.'     +Infinity') call abort
+       write(l,fmt=fmt)neg_inf
+       if (l.ne.'     -Infinity') call abort
+       write(l,fmt=fmt)nan
+       if (l.ne.'           NaN') call abort
+       end
+

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index e9f17ee05bd24d98e8ecd75d5e6088fbb883ace9..a00f03faf3402524c28864eaa15a9f8746cdbfa4 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,8 @@
+2004-06-12  Bud Davis  <bdavis9659@comcast.net>
+
+       PR gfortran/12839
+       * io/write.c(write_float): format inf and nan IAW F2003.
+
 2004-06-09  Bud Davis  <bdavis9659@comcaste.net>
 
        PR gfortran/14897

diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index 0719f88ff1dee4ff24d1f30a232eee9c86811d46..e4f597cbd040254934275ad2777aad4eb9d6421d 100644 (file)
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -515,11 +515,14 @@ write_float (fnode *f, const char *source, int len)
      if (res == 0)
        {
          nb =  f->u.real.w;
-         if (nb <= 4)
-            nb = 4;
          p = write_block (nb);
-         memset (p, ' ' , 1);
-         
+         if (nb < 3)
+         {
+             memset (p, '*',nb);
+             return;
+         }
+
+         memset(p, ' ', nb);
          res = isinf (n);
          if (res != 0)
          {
@@ -527,11 +530,18 @@ write_float (fnode *f, const char *source, int len)
                fin = '+';
             else
                fin = '-';
-         
-             memset (p + 1, fin, nb - 1);
+
+            if (nb > 7)
+               memcpy(p + nb - 8, "Infinity", 8); 
+            else
+               memcpy(p + nb - 3, "Inf", 3);
+            if (nb < 8)
+               memset(p + nb - 4, fin, 1);
+            else if (nb > 8)
+               memset(p + nb - 9, fin, 1); 
           }
          else
-             sprintf(p + 1, "NaN");
+             memcpy(p + nb - 3, "NaN", 3);
          return;
        }
    }