[fortran] patch for PR 12839 - incorrect IO of inf
Bud Davis
bdavis9659@comcast.net
Sun Feb 29 19:04:00 GMT 2004
Below is a patch for your consideration that implements the output of
+inf/-inf/nan as per the draft Fortran 2003 standard. At least it is my
attempt to implement it properly :)
Tested on i686/linux with no additional test suite failures.
Here is a test case, that demonstrates it:
! pr12839 - output infinity using F2003 standard
implicit none
real zero,nan,pos_inf,neg_inf
character*30 B,info
logical debug
integer test_count,fail_count
common test_count,fail_count,debug
!
debug = .FALSE.
test_count = 0
fail_count = 0
zero = 0.0
pos_inf = 1.0/zero
neg_inf = -1.0/zero
nan = zero/zero
!
! check field < 3
call check('pos inf field oflow','(F2.0)',pos_inf,'**',2)
call check('neg inf field oflow','(F2.0)',neg_inf,'**',2)
call check('nan field oflow','(F2.0)',nan ,'**',2)
!
! check field = 3
call check('pos inf no +/-','(F3.0)',pos_inf,'Inf',3)
call check('neg inf no +/-','(F3.0)',neg_inf,'Inf',3)
call check('nan ','(F3.0)',nan ,'NaN',3)
!
! check field > 3
call check('pos inf ','(F4.0)',pos_inf,'+Inf',4)
call check('neg inf ','(F4.0)',neg_inf,'-Inf',4)
call check('nan ','(F4.0)',nan ,' NaN',4)
! check field = 7
call check('pos inf ','(F7.1)',pos_inf,' +Inf',7)
call check('neg inf ','(F7.1)',neg_inf,' -Inf',7)
call check('nan ','(F7.1)',nan ,' NaN',7)
! check field = 8
call check('pos inf ','(F8.0)',pos_inf,'Infinity',8)
call check('neg inf ','(F8.0)',neg_inf,'Infinity',8)
call check('nan ','(F8.0)',nan ,' NaN',8)
! check field = 9
call check('pos inf ','(F9.2)',pos_inf,'+Infinity',9)
call check('neg inf ','(F9.2)',neg_inf,'-Infinity',9)
call check('nan ','(F9.2)',nan ,' NaN',9)
! check field = 14
call check('pos inf ','(F14.0)',pos_inf,' +Infinity',14)
call check('neg inf ','(F14.0)',neg_inf,' -Infinity',14)
call check('nan ','(F14.0)',nan ,' NaN',14)
if (debug)print*,'Ran ',test_count,' with ',fail_count,' failures.'
end
subroutine check(info,fmt,value,exp,len)
implicit none
logical debug
character(len=*) fmt,exp,info
character*30 B
real value
integer len,test_count,fail_count,i
common test_count,fail_count,debug
test_count = test_count + 1
B = ''
write(B,fmt)value
if (debug) print*,'---------------'
if (debug) print*,'TEST: ',info
if (debug) print*,'INTERNAL WRITE: ',B(1:len),' FORMAT: ',fmt
if (B(1:len).NE.exp(1:len)) then
print*,' is ',B(1:len),' should be ',exp,' fmt is ',fmt
fail_count = fail_count + 1
do i = 1,len
print*,'i = ',i,' ',B(i:i)
enddo
if (.not.debug) call abort
endif
return
end
2004-02-28 Bud Davis <bdavis9659@comcast.net>
* io/write.c (write_float): PR12839 Change +-inf and NaN to
F2003 standard.
Index: gcc/libgfortran/io/write.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/io/Attic/write.c,v
retrieving revision 1.1.2.7
diff -c -3 -p -r1.1.2.7 write.c
*** gcc/libgfortran/io/write.c 1 Jan 2004 13:57:04 -0000 1.1.2.7
--- gcc/libgfortran/io/write.c 29 Feb 2004 16:09:40 -0000
*************** write_float (fnode *f, const char *sourc
*** 507,516 ****
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)
--- 507,520 ----
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
*** 519,529 ****
fin = '+';
else
fin = '-';
!
! memset (p + 1, fin, nb - 1);
}
else
! sprintf(p + 1, "NaN");
return;
}
}
--- 523,541 ----
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;
}
}
More information about the Gcc-patches
mailing list