re PR libfortran/33469 (Default formats for real input are not precise enough)
PR libfortran/33469 * io/write.c (write_real): Widen the default formats. * gfortran.dg/default_format_1.f90: New test. * gfortran.dg/default_format_2.f90: New test. * gfortran.dg/namelist_print_1.f: Adjust expected output. * gfortran.dg/real_const_3.f90: Adjust expected output. From-SVN: r128967
This commit is contained in:
Francois-Xavier Coudert
François-Xavier Coudert
parent
729fd517d9
commit
e900e0ca88
|
|
@ -1,3 +1,11 @@
|
|||
2007-10-03 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
|
||||
|
||||
PR libfortran/33469
|
||||
* gfortran.dg/default_format_1.f90: New test.
|
||||
* gfortran.dg/default_format_2.f90: New test.
|
||||
* gfortran.dg/namelist_print_1.f: Adjust expected output.
|
||||
* gfortran.dg/real_const_3.f90: Adjust expected output.
|
||||
|
||||
2007-10-02 Richard Sandiford <rsandifo@nildram.co.uk>
|
||||
|
||||
* gcc.target/mips/mips.exp (setup_mips_tests): Set mips_abi to the
|
||||
|
|
|
|||
|
|
@ -0,0 +1,101 @@
|
|||
! { dg-do run }
|
||||
!
|
||||
! This tests that the default formats for formatted I/O of reals are
|
||||
! wide enough and have enough precision, by checking that values can
|
||||
! be written and read back.
|
||||
!
|
||||
module test_default_format
|
||||
interface test
|
||||
module procedure test_r4
|
||||
module procedure test_r8
|
||||
end interface test
|
||||
|
||||
integer, parameter :: count = 200
|
||||
|
||||
contains
|
||||
function test_r4 (start, towards) result (res)
|
||||
integer, parameter :: k = 4
|
||||
integer, intent(in) :: towards
|
||||
real(k), intent(in) :: start
|
||||
|
||||
integer :: res, i
|
||||
real(k) :: x, y
|
||||
character(len=100) :: s
|
||||
|
||||
res = 0
|
||||
|
||||
if (towards >= 0) then
|
||||
x = start
|
||||
do i = 0, count
|
||||
write (s,*) x
|
||||
read (s,*) y
|
||||
if (y /= x) res = res + 1
|
||||
x = nearest(x,huge(x))
|
||||
end do
|
||||
end if
|
||||
|
||||
if (towards <= 0) then
|
||||
x = start
|
||||
do i = 0, count
|
||||
write (s,*) x
|
||||
read (s,*) y
|
||||
if (y /= x) res = res + 1
|
||||
x = nearest(x,-huge(x))
|
||||
end do
|
||||
end if
|
||||
end function test_r4
|
||||
|
||||
function test_r8 (start, towards) result (res)
|
||||
integer, parameter :: k = 8
|
||||
integer, intent(in) :: towards
|
||||
real(k), intent(in) :: start
|
||||
|
||||
integer :: res, i
|
||||
real(k) :: x, y
|
||||
character(len=100) :: s
|
||||
|
||||
res = 0
|
||||
|
||||
if (towards >= 0) then
|
||||
x = start
|
||||
do i = 0, count
|
||||
write (s,*) x
|
||||
read (s,*) y
|
||||
if (y /= x) res = res + 1
|
||||
x = nearest(x,huge(x))
|
||||
end do
|
||||
end if
|
||||
|
||||
if (towards <= 0) then
|
||||
x = start
|
||||
do i = 0, count
|
||||
write (s,*) x
|
||||
read (s,*) y
|
||||
if (y /= x) res = res + 1
|
||||
x = nearest(x,-huge(x))
|
||||
end do
|
||||
end if
|
||||
end function test_r8
|
||||
|
||||
end module test_default_format
|
||||
|
||||
program main
|
||||
use test_default_format
|
||||
|
||||
if (test (1.0_4, 0) /= 0) call abort
|
||||
if (test (0.0_4, 0) /= 0) call abort
|
||||
if (test (tiny(0.0_4), 0) /= 0) call abort
|
||||
if (test (-tiny(0.0_4), 0) /= 0) call abort
|
||||
if (test (huge(0.0_4), -1) /= 0) call abort
|
||||
if (test (-huge(0.0_4), 1) /= 0) call abort
|
||||
|
||||
if (test (1.0_8, 0) /= 0) call abort
|
||||
if (test (0.0_8, 0) /= 0) call abort
|
||||
if (test (tiny(0.0_8), 0) /= 0) call abort
|
||||
if (test (-tiny(0.0_8), 0) /= 0) call abort
|
||||
if (test (huge(0.0_8), -1) /= 0) call abort
|
||||
if (test (-huge(0.0_8), 1) /= 0) call abort
|
||||
|
||||
end program main
|
||||
!
|
||||
! { dg-final { cleanup-modules "test_default_format" } }
|
||||
|
|
@ -0,0 +1,64 @@
|
|||
! { dg-do run }
|
||||
! { dg-require-effective-target fortran_large_real }
|
||||
!
|
||||
! This tests that the default formats for formatted I/O of reals are
|
||||
! wide enough and have enough precision, by checking that values can
|
||||
! be written and read back.
|
||||
!
|
||||
module test_default_format
|
||||
interface test
|
||||
module procedure test_rl
|
||||
end interface test
|
||||
|
||||
integer, parameter :: kl = selected_real_kind (precision (0.0_8) + 1)
|
||||
integer, parameter :: count = 200
|
||||
|
||||
contains
|
||||
|
||||
function test_rl (start, towards) result (res)
|
||||
integer, parameter :: k = kl
|
||||
integer, intent(in) :: towards
|
||||
real(k), intent(in) :: start
|
||||
|
||||
integer :: res, i
|
||||
real(k) :: x, y
|
||||
character(len=100) :: s
|
||||
|
||||
res = 0
|
||||
|
||||
if (towards >= 0) then
|
||||
x = start
|
||||
do i = 0, count
|
||||
write (s,*) x
|
||||
read (s,*) y
|
||||
if (y /= x) res = res + 1
|
||||
x = nearest(x,huge(x))
|
||||
end do
|
||||
end if
|
||||
|
||||
if (towards <= 0) then
|
||||
x = start
|
||||
do i = 0, count
|
||||
write (s,*) x
|
||||
read (s,*) y
|
||||
if (y /= x) res = res + 1
|
||||
x = nearest(x,-huge(x))
|
||||
end do
|
||||
end if
|
||||
end function test_rl
|
||||
|
||||
end module test_default_format
|
||||
|
||||
program main
|
||||
use test_default_format
|
||||
|
||||
if (test (1.0_kl, 0) /= 0) call abort
|
||||
if (test (0.0_kl, 0) /= 0) call abort
|
||||
if (test (tiny(0.0_kl), 0) /= 0) call abort
|
||||
if (test (-tiny(0.0_kl), 0) /= 0) call abort
|
||||
if (test (huge(0.0_kl), -1) /= 0) call abort
|
||||
if (test (-huge(0.0_kl), 1) /= 0) call abort
|
||||
|
||||
end program main
|
||||
!
|
||||
! { dg-final { cleanup-modules "test_default_format" } }
|
||||
|
|
@ -9,5 +9,5 @@
|
|||
namelist /mynml/ x
|
||||
x = 1
|
||||
! ( dg-output "^" }
|
||||
print mynml ! { dg-output "&MYNML(\n|\r\n|\r) X= 1.000000 , /(\n|\r\n|\r)" }
|
||||
print mynml ! { dg-output "&MYNML(\n|\r\n|\r) X= 1.00000000 , /(\n|\r\n|\r)" }
|
||||
end
|
||||
|
|
|
|||
|
|
@ -27,15 +27,15 @@ program main
|
|||
|
||||
end program main
|
||||
!{ dg-output " \\+Infinity(\n|\r\n|\r)" }
|
||||
!{ dg-output " 0.000000 (\n|\r\n|\r)" }
|
||||
!{ dg-output " -Infinity(\n|\r\n|\r)" }
|
||||
!{ dg-output " NaN(\n|\r\n|\r)" }
|
||||
!{ dg-output " NaN(\n|\r\n|\r)" }
|
||||
!{ dg-output " -Infinity(\n|\r\n|\r)" }
|
||||
!{ dg-output " -Infinity(\n|\r\n|\r)" }
|
||||
!{ dg-output " \\+Infinity(\n|\r\n|\r)" }
|
||||
!{ dg-output " NaN(\n|\r\n|\r)" }
|
||||
!{ dg-output " \\( NaN, NaN\\)(\n|\r\n|\r)" }
|
||||
!{ dg-output " \\( NaN, NaN\\)(\n|\r\n|\r)" }
|
||||
!{ dg-output " \\( \\+Infinity, -Infinity\\)(\n|\r\n|\r)" }
|
||||
!{ dg-output " \\( 0.000000 , -0.000000 \\)(\n|\r\n|\r)" }
|
||||
!{ dg-output " 0.0000000 (\n|\r\n|\r)" }
|
||||
!{ dg-output " -Infinity(\n|\r\n|\r)" }
|
||||
!{ dg-output " NaN(\n|\r\n|\r)" }
|
||||
!{ dg-output " NaN(\n|\r\n|\r)" }
|
||||
!{ dg-output " -Infinity(\n|\r\n|\r)" }
|
||||
!{ dg-output " -Infinity(\n|\r\n|\r)" }
|
||||
!{ dg-output " \\+Infinity(\n|\r\n|\r)" }
|
||||
!{ dg-output " NaN(\n|\r\n|\r)" }
|
||||
!{ dg-output " \\( NaN, NaN\\)(\n|\r\n|\r)" }
|
||||
!{ dg-output " \\( NaN, NaN\\)(\n|\r\n|\r)" }
|
||||
!{ dg-output " \\( \\+Infinity, -Infinity\\)(\n|\r\n|\r)" }
|
||||
!{ dg-output " \\( 0.0000000 , -0.0000000 \\)(\n|\r\n|\r)" }
|
||||
|
|
|
|||
|
|
@ -1,3 +1,8 @@
|
|||
2007-10-02 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
|
||||
|
||||
PR fortran/33469
|
||||
* io/write.c (write_real): Widen the default formats.
|
||||
|
||||
2007-09-28 Jerry DeLisle <jvdelisle@gcc.gnu.org>
|
||||
|
||||
PR libfortran/33400
|
||||
|
|
|
|||
|
|
@ -698,18 +698,18 @@ write_real (st_parameter_dt *dtp, const char *source, int length)
|
|||
switch (length)
|
||||
{
|
||||
case 4:
|
||||
f.u.real.w = 14;
|
||||
f.u.real.d = 7;
|
||||
f.u.real.w = 15;
|
||||
f.u.real.d = 8;
|
||||
f.u.real.e = 2;
|
||||
break;
|
||||
case 8:
|
||||
f.u.real.w = 23;
|
||||
f.u.real.d = 15;
|
||||
f.u.real.w = 25;
|
||||
f.u.real.d = 17;
|
||||
f.u.real.e = 3;
|
||||
break;
|
||||
case 10:
|
||||
f.u.real.w = 28;
|
||||
f.u.real.d = 19;
|
||||
f.u.real.w = 29;
|
||||
f.u.real.d = 20;
|
||||
f.u.real.e = 4;
|
||||
break;
|
||||
case 16:
|
||||
|
|
|
|||
Loading…
Reference in New Issue