OSDN Git Service

(root) / pf3gnuchains / gcc-fork.git / commitdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: 8ed3037)
PR libfortran/33469
authorfxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 2 Oct 2007 23:27:51 +0000 (23:27 +0000)
committerfxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 2 Oct 2007 23:27:51 +0000 (23:27 +0000)
* 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 patch | blob | history
gcc/testsuite/gfortran.dg/default_format_1.f90 [new file with mode: 0644] patch | blob
gcc/testsuite/gfortran.dg/default_format_2.f90 [new file with mode: 0644] patch | blob
gcc/testsuite/gfortran.dg/namelist_print_1.f patch | blob | history
gcc/testsuite/gfortran.dg/real_const_3.f90 patch | blob | history
libgfortran/ChangeLog patch | blob | history
libgfortran/io/write.c patch | blob | history

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 2e45a08..adab396 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/default_format_1.f90 b/gcc/testsuite/gfortran.dg/default_format_1.f90
new file mode 100644 (file)
index 0000000..6183a34
--- /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 (file)
index 0000000..af6d4a6
--- /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 dfd2841..5c0e775 100644 (file)
--- 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 533b4af..d6b2a96 100644 (file)
--- 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 aaa37a4..7392997 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -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
diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index 4792a22..84b695f 100644 (file)
--- 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:
About OSDN
Find Software
Develop Software
Help