default_format_denormal_2.f90: New test.

	* gfortran.dg/default_format_denormal_2.f90: New test.
	* gfortran.dg/default_format_2.inc: New test.
	* gfortran.dg/default_format_denormal_1.f90: New test.
	* gfortran.dg/default_format_1.inc: New test.
	* gfortran.dg/default_format_1.f90: Don't test for denormalized
	numbers.
	* gfortran.dg/default_format_2.f90: Don't test for denormalized
	numbers.

From-SVN: r129057

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 5bd7518..68b2349 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,14 @@
+2007-10-06  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+       * gfortran.dg/default_format_denormal_2.f90: New test.
+       * gfortran.dg/default_format_2.inc: New test.
+       * gfortran.dg/default_format_denormal_1.f90: New test.
+       * gfortran.dg/default_format_1.inc: New test.
+       * gfortran.dg/default_format_1.f90: Don't test for denormalized
+       numbers.
+       * gfortran.dg/default_format_2.f90: Don't test for denormalized
+       numbers.
+
 2007-10-06  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        * gfortran.dg/namelist_15.f90: Revise test.

diff --git a/gcc/testsuite/gfortran.dg/default_format_1.f90 b/gcc/testsuite/gfortran.dg/default_format_1.f90
index e63f175..b8dd072 100644 (file)
--- a/gcc/testsuite/gfortran.dg/default_format_1.f90
+++ b/gcc/testsuite/gfortran.dg/default_format_1.f90
@@ -1,4 +1,4 @@
-! { dg-do run { xfail *-apple-darwin* } }
+! { dg-do run }
 ! Test XFAILed on Darwin because the system's printf() lacks
 ! proper support for denormals.
 !
@@ -6,98 +6,24 @@
 ! 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
+include "default_format_1.inc"
 
 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 (tiny(0.0_4), 1) /= 0) call abort
+  if (test (-tiny(0.0_4), -1) /= 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 (tiny(0.0_8), 1) /= 0) call abort
+  if (test (-tiny(0.0_8), -1) /= 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_1.inc b/gcc/testsuite/gfortran.dg/default_format_1.inc
new file mode 100644 (file)
index 0000000..e5d711c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/default_format_1.inc
@@ -0,0 +1,74 @@
+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

diff --git a/gcc/testsuite/gfortran.dg/default_format_2.f90 b/gcc/testsuite/gfortran.dg/default_format_2.f90
index 8574222..ab4feee 100644 (file)
--- a/gcc/testsuite/gfortran.dg/default_format_2.f90
+++ b/gcc/testsuite/gfortran.dg/default_format_2.f90
@@ -7,60 +7,17 @@
 ! 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
+include "default_format_2.inc"
 
 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 (tiny(0.0_kl), 1) /= 0) call abort
+  if (test (-tiny(0.0_kl), -1) /= 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/default_format_2.inc b/gcc/testsuite/gfortran.dg/default_format_2.inc
new file mode 100644 (file)
index 0000000..7306f07
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/default_format_2.inc
@@ -0,0 +1,43 @@
+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

diff --git a/gcc/testsuite/gfortran.dg/default_format_denormal_1.f90 b/gcc/testsuite/gfortran.dg/default_format_denormal_1.f90
new file mode 100644 (file)
index 0000000..5213b2e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/default_format_denormal_1.f90
@@ -0,0 +1,21 @@
+! { dg-do run { xfail *-apple-darwin* } }
+! Test XFAILed on these platforms because the system's printf() lacks
+! proper support for denormals.
+!
+! 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.
+!
+include "default_format_1.inc"
+
+program main
+  use test_default_format
+
+  if (test (tiny(0.0_4), -1) /= 0) call abort
+  if (test (-tiny(0.0_4), 1) /= 0) call abort
+
+  if (test (tiny(0.0_8), -1) /= 0) call abort
+  if (test (-tiny(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_denormal_2.f90 b/gcc/testsuite/gfortran.dg/default_format_denormal_2.f90
new file mode 100644 (file)
index 0000000..93b5d93
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/default_format_denormal_2.f90
@@ -0,0 +1,19 @@
+! { dg-require-effective-target fortran_large_real }
+! { dg-do run { xfail powerpc*-apple-darwin* } }
+! Test XFAILed on these platforms because the system's printf() lacks
+! proper support for denormalized long doubles.
+!
+! 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.
+!
+include "default_format_2.inc"
+
+program main
+  use test_default_format
+
+  if (test (tiny(0.0_kl), -1) /= 0) call abort
+  if (test (-tiny(0.0_kl), 1) /= 0) call abort
+end program main
+!
+! { dg-final { cleanup-modules "test_default_format" } }