OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR libfortran/12839 (incorrect IO of Inf)

Browse Source 
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
This commit is contained in:
Bud Davis 2004-06-12 12:50:54 +00:00 committed by Bud Davis
parent 3d27dbd01a
commit 8204210bd6
4 changed files with 106 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
gcc/testsuite/ChangeLog
View File

@ -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

79
gcc/testsuite/gfortran.fortran-torture/execute/nan_inf_fmt.f90 Normal file
View File

@ -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

5
libgfortran/ChangeLog
View File

@ -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

24
libgfortran/io/write.c
View File

@ -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;
}
}