This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
Re: [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>
- Cc: gfortran <fortran at gcc dot gnu dot org>
- Date: Sun, 06 Jun 2004 20:01:18 -0500
- Subject: Re: [gfortran] patch for pr12839 / F2003 format of Inf and NaN
- References: <1086567830.31849.8.camel@localhost.localdomain>
just realized that snprintf was putting a trailing '0' into the output.
replaced snprintf with memcpy.
below is a revised patch and test file.
--bud
!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.ne.'Inf') call abort
write(l,fmt=fmt)neg_inf
if (debug) print*,fmt,l
if (l.ne.'Inf') call abort
write(l,fmt=fmt)nan
if (debug) print*,fmt,l
if (l.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.ne.'+Inf') call abort
write(l,fmt=fmt)neg_inf
if (debug) print*,fmt,l
if (l.ne.'-Inf') call abort
write(l,fmt=fmt)nan
if (debug) print*,fmt,l
if (l.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.ne.' +Inf') call abort
write(l,fmt=fmt)neg_inf
if (debug) print*,fmt,l
if (l.ne.' -Inf') call abort
write(l,fmt=fmt)nan
if (debug) print*,fmt,l
if (l.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.ne.'Infinity') call abort
write(l,fmt=fmt)neg_inf
if (debug) print*,fmt,l
if (l.ne.'Infinity') call abort
write(l,fmt=fmt)nan
if (debug) print*,fmt,l
if (l.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.ne.'+Infinity') call abort
write(l,fmt=fmt)neg_inf
if (debug) print*,fmt,l
if (l.ne.'-Infinity') call abort
write(l,fmt=fmt)nan
if (debug) print*,fmt,l
if (l.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.ne.' +Infinity') call abort
write(l,fmt=fmt)neg_inf
if (debug) print*,fmt,l
if (l.ne.' -Infinity') call abort
write(l,fmt=fmt)nan
if (debug) print*,fmt,l
if (l.ne.' NaN') call abort
if (debug) print*,'all passed.'
end
Index: gcc/libgfortran/io/write.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/io/write.c,v
retrieving revision 1.5
diff -c -3 -p -r1.5 write.c
*** gcc/libgfortran/io/write.c 16 May 2004 20:17:04 -0000 1.5
--- gcc/libgfortran/io/write.c 7 Jun 2004 00:56:25 -0000
*************** write_float (fnode *f, const char *sourc
*** 515,525 ****
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;
}
}
--- 530,547 ----
fin = '+';
else
fin = '-';
!
! 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
! memcpy(p + nb - 3, "NaN", 3);
return;
}
}