This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[gfortran] patch for pr12839 / F2003 format of Inf and NaN
- From: Bud Davis <bdavis9659 at comcast dot net>
- To: "gcc-patches at gcc dot gnu dot org" <gcc-patches at gcc dot gnu dot org>, gfortran <fortran at gcc dot gnu dot org>
- Date: Sun, 06 Jun 2004 19:23:50 -0500
- Subject: [gfortran] patch for pr12839 / F2003 format of Inf and NaN
Displays +inf, -inf, and Nan like this:
(F2.0) **
(F2.0) **
(F2.0) **
(F3.0) Inf
(F3.0) Inf
(F3.0) NaN
(F4.0) +Inf
(F4.0) -Inf
(F4.0) NaN
(F7.0) +Inf
(F7.0) -Inf
(F7.0) NaN
(F8.0) Infinity
(F8.0) Infinity
(F8.0) NaN
(F9.0) +Infinity
(F9.0) -Infinity
(F9.0) NaN
(F14.0) +Infinity
(F14.0) -Infinity
(F14.0) NaN
No additional failure on i686/gnu/linux.
Change Log:
2004-06-06 Bud Davis <bdavis9659@comcast.net>
PR gfortran/12839
* format.c (write_float): format inf and nan IAW F2003
--bud
Index: gcc/libgfortran/io/write.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/io/Attic/write.c,v
retrieving revision 1.1.2.9
diff -c -3 -p -r1.1.2.9 write.c
*** gcc/libgfortran/io/write.c 1 Apr 2004 01:32:46 -0000 1.1.2.9
--- gcc/libgfortran/io/write.c 25 Apr 2004 02:24:32 -0000
*************** write_float (fnode *f, const char *sourc
*** 515,524 ****
if (res == 0)
{
nb = f->u.real.w;
- if (nb <= 4)
- nb = 4;
p = write_block (nb);
! memset (p, ' ' , 1);
res = isinf (n);
if (res != 0)
--- 515,528 ----
if (res == 0)
{
nb = f->u.real.w;
p = write_block (nb);
! if (nb < 3)
! {
! memset (p, '*',nb);
! return;
! }
!
! memset(p, ' ', nb);
res = isinf (n);
if (res != 0)
*************** write_float (fnode *f, const char *sourc
*** 527,537 ****
fin = '+';
else
fin = '-';
!
! memset (p + 1, fin, nb - 1);
}
else
! sprintf(p + 1, "NaN");
return;
}
}
--- 531,549 ----
fin = '+';
else
fin = '-';
!
! if (nb > 7)
! sprintf(p + nb - 8, "Infinity");
! else
! sprintf(p + nb - 3, "Inf");
!
! if (nb < 8)
! memset(p + nb - 4, fin, 1);
! else if (nb > 8)
! memset(p + nb - 9, fin, 1);
}
else
! sprintf(p + nb -3 , "NaN");
return;
}
}
!pr 12839- F2003 formatting of Inf /Nan
implicit none
character*40 l
character*12 fmt
logical debug
data debug /.FALSE./
real zero, pos_inf, neg_inf, nan
zero = 0.0
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 (debug) print*,fmt,l
if (l.ne.'**') call abort
write(l,fmt=fmt)neg_inf
if (debug) print*,fmt,l
if (l.ne.'**') call abort
write(l,fmt=fmt)nan
if (debug) print*,fmt,l
if (l.ne.'**') call abort
! check a field width = 3
fmt = '(F3.0)'
write(l,fmt=fmt)pos_inf
if (debug) print*,fmt,l(1:3)
if (l(1:3).ne.'Inf') call abort
write(l,fmt=fmt)neg_inf
if (debug) print*,fmt,l
if (l(1:3).ne.'Inf') call abort
write(l,fmt=fmt)nan
if (debug) print*,fmt,l
if (l(1:3).ne.'NaN') call abort
! check a field width > 3
fmt = '(F4.0)'
write(l,fmt=fmt)pos_inf
if (debug) print*,fmt,l
if (l(1:4).ne.'+Inf') call abort
write(l,fmt=fmt)neg_inf
if (debug) print*,fmt,l
if (l(1:4).ne.'-Inf') call abort
write(l,fmt=fmt)nan
if (debug) print*,fmt,l
if (l(1:4).ne.' NaN') call abort
! check a field width = 7
fmt = '(F7.0)'
write(l,fmt=fmt)pos_inf
if (debug) print*,fmt,l
if (l(1:7).ne.' +Inf') call abort
write(l,fmt=fmt)neg_inf
if (debug) print*,fmt,l
if (l(1:7).ne.' -Inf') call abort
write(l,fmt=fmt)nan
if (debug) print*,fmt,l
if (l(1:7).ne.' NaN') call abort
! check a field width = 8
fmt = '(F8.0)'
write(l,fmt=fmt)pos_inf
if (debug) print*,fmt,l
if (l(1:8).ne.'Infinity') call abort
write(l,fmt=fmt)neg_inf
if (debug) print*,fmt,l
if (l(1:8).ne.'Infinity') call abort
write(l,fmt=fmt)nan
if (debug) print*,fmt,l
if (l(1:8).ne.' NaN') call abort
! check a field width = 9
fmt = '(F9.0)'
write(l,fmt=fmt)pos_inf
if (debug) print*,fmt,l
if (l(1:9).ne.'+Infinity') call abort
write(l,fmt=fmt)neg_inf
if (debug) print*,fmt,l
if (l(1:9).ne.'-Infinity') call abort
write(l,fmt=fmt)nan
if (debug) print*,fmt,l
if (l(1:9).ne.' NaN') call abort
! check a field width = 14
fmt = '(F14.0)'
write(l,fmt=fmt)pos_inf
if (debug) print*,fmt,l
if (l(1:14).ne.' +Infinity') call abort
write(l,fmt=fmt)neg_inf
if (debug) print*,fmt,l
if (l(1:14).ne.' -Infinity') call abort
write(l,fmt=fmt)nan
if (debug) print*,fmt,l
if (l(1:14).ne.' NaN') call abort
if (debug) print*,'all passed.'
end