From 3b294b67663b62f2b6a447fd501ed2ad7141222d Mon Sep 17 00:00:00 2001 From: fxcoudert Date: Tue, 2 Oct 2007 23:27:51 +0000 Subject: [PATCH] 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@128967 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/testsuite/ChangeLog | 8 ++ gcc/testsuite/gfortran.dg/default_format_1.f90 | 101 +++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/default_format_2.f90 | 64 ++++++++++++++++ gcc/testsuite/gfortran.dg/namelist_print_1.f | 2 +- gcc/testsuite/gfortran.dg/real_const_3.f90 | 24 +++--- libgfortran/ChangeLog | 5 ++ libgfortran/io/write.c | 12 +-- 7 files changed, 197 insertions(+), 19 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/default_format_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/default_format_2.f90 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 2e45a08cff4..adab396193e 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2007-10-03 Francois-Xavier Coudert + + 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 * gcc.target/mips/mips.exp (setup_mips_tests): Set mips_abi to the diff --git a/gcc/testsuite/gfortran.dg/default_format_1.f90 b/gcc/testsuite/gfortran.dg/default_format_1.f90 new file mode 100644 index 00000000000..6183a345725 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/default_format_1.f90 @@ -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" } } diff --git a/gcc/testsuite/gfortran.dg/default_format_2.f90 b/gcc/testsuite/gfortran.dg/default_format_2.f90 new file mode 100644 index 00000000000..af6d4a666f8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/default_format_2.f90 @@ -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" } } diff --git a/gcc/testsuite/gfortran.dg/namelist_print_1.f b/gcc/testsuite/gfortran.dg/namelist_print_1.f index dfd2841f022..5c0e7759088 100644 --- a/gcc/testsuite/gfortran.dg/namelist_print_1.f +++ b/gcc/testsuite/gfortran.dg/namelist_print_1.f @@ -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 diff --git a/gcc/testsuite/gfortran.dg/real_const_3.f90 b/gcc/testsuite/gfortran.dg/real_const_3.f90 index 533b4af65f0..d6b2a968d8e 100644 --- a/gcc/testsuite/gfortran.dg/real_const_3.f90 +++ b/gcc/testsuite/gfortran.dg/real_const_3.f90 @@ -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)" } diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index aaa37a4a503..7392997e2af 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,8 @@ +2007-10-02 Francois-Xavier Coudert + + PR fortran/33469 + * io/write.c (write_real): Widen the default formats. + 2007-09-28 Jerry DeLisle PR libfortran/33400 diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c index 4792a222b9a..84b695fa883 100644 --- a/libgfortran/io/write.c +++ b/libgfortran/io/write.c @@ -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: -- 2.11.0