From: Francois-Xavier Coudert Date: Sat, 6 Oct 2007 21:22:39 +0000 (+0000) Subject: default_format_denormal_2.f90: New test. X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=ce2a7a944beea83da44ade1b2109423279f06114;p=platform%2Fupstream%2Fgcc.git 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 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,14 @@ +2007-10-06 Francois-Xavier Coudert + + * 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 * 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 --- 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 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 --- 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 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 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 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" } }