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

re PR libfortran/47567 (Wrong output for small absolute values with F editing)

Browse Source 
2011-02-28  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/47567
	* gfortran.dg/fmt_fw_d.f90: New test.

From-SVN: r170586
This commit is contained in:
Jerry DeLisle 2011-03-01 02:28:02 +00:00
parent 0eac6ca562
commit 4d45fb2192
2 changed files with 135 additions and 0 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 @@
2011-02-28 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libgfortran/47567
* gfortran.dg/fmt_fw_d.f90: New test.
2011-02-28 Jason Merrill <jason@redhat.com>
* g++.dg/inherit/covariant18.C: New.

130
gcc/testsuite/gfortran.dg/fmt_fw_d.f90 Normal file
View File

@ -0,0 +1,130 @@
! { dg-do run }
! PR47567 Wrong output for small absolute values with F editing
! Test case provided by Thomas Henlich
call verify_fmt(1.2)
call verify_fmt(-0.1)
call verify_fmt(1e-7)
call verify_fmt(1e-6)
call verify_fmt(1e-5)
call verify_fmt(1e-4)
call verify_fmt(1e-3)
call verify_fmt(1e-2)
call verify_fmt(-1e-7)
call verify_fmt(-1e-6)
call verify_fmt(-1e-5)
call verify_fmt(-1e-4)
call verify_fmt(-1e-3)
call verify_fmt(-1e-2)
call verify_fmt(tiny(0.0))
call verify_fmt(-tiny(0.0))
call verify_fmt(0.0)
call verify_fmt(-0.0)
call verify_fmt(100.0)
call verify_fmt(.12345)
call verify_fmt(1.2345)
call verify_fmt(12.345)
call verify_fmt(123.45)
call verify_fmt(1234.5)
call verify_fmt(12345.6)
call verify_fmt(123456.7)
call verify_fmt(99.999)
call verify_fmt(-100.0)
call verify_fmt(-99.999)
end
! loop through values for w, d
subroutine verify_fmt(x)
real, intent(in) :: x
integer :: w, d
character(len=80) :: str, str0
integer :: len, len0
character(len=80) :: fmt_w_d
logical :: result, have_num, verify_fmt_w_d
do d = 0, 10
have_num = .false.
do w = 1, 20
str = fmt_w_d(x, w, d)
len = len_trim(str)
result = verify_fmt_w_d(x, str, len, w, d)
if (.not. have_num .and. result) then
have_num = .true.
str0 = fmt_w_d(x, 0, d)
len0 = len_trim(str0)
if (len /= len0) then
call errormsg(x, str0, len0, 0, d, "selected width is wrong")
else
if (str(:len) /= str0(:len0)) call errormsg(x, str0, len0, 0, d, "output is wrong")
end if
end if
end do
end do
end subroutine
! checks for standard-compliance, returns .true. if field contains number, .false. on overflow
function verify_fmt_w_d(x, str, len, w, d)
real, intent(in) :: x
character(len=80), intent(in) :: str
integer, intent(in) :: len
integer, intent(in) :: w, d
logical :: verify_fmt_w_d
integer :: pos
character :: decimal_sep = "."
verify_fmt_w_d = .false.
! check if string is all asterisks
pos = verify(str(:len), "*")
if (pos == 0) return
! check if string contains a digit
pos = scan(str(:len), "0123456789")
if (pos == 0) call errormsg(x, str, len, w, d, "no digits")
! contains decimal separator?
pos = index(str(:len), decimal_sep)
if (pos == 0) call errormsg(x, str, len, w, d, "no decimal separator")
! negative and starts with minus?
if (sign(1., x) < 0.) then
pos = verify(str, " ")
if (pos == 0) call errormsg(x, str, len, w, d, "only spaces")
if (str(pos:pos) /= "-") call errormsg(x, str, len, w, d, "no minus sign")
end if
verify_fmt_w_d = .true.
end function
function fmt_w_d(x, w, d)
real, intent(in) :: x
integer, intent(in) :: w, d
character(len=*) :: fmt_w_d
character(len=10) :: fmt, make_fmt
fmt = make_fmt(w, d)
write (fmt_w_d, fmt) x
end function
function make_fmt(w, d)
integer, intent(in) :: w, d
character(len=10) :: make_fmt
write (make_fmt,'("(f",i0,".",i0,")")') w, d
end function
subroutine errormsg(x, str, len, w, d, reason)
real, intent(in) :: x
character(len=80), intent(in) :: str
integer, intent(in) :: len, w, d
character(len=*), intent(in) :: reason
integer :: fmt_len
character(len=10) :: fmt, make_fmt
fmt = make_fmt(w, d)
fmt_len = len_trim(fmt)
!print *, "print '", fmt(:fmt_len), "', ", x, " ! => ", str(:len), ": ", reason
call abort
end subroutine