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
This commit is contained in:
parent
2f09ef38b8
commit
ce2a7a944b
@ -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.
|
||||
|
@ -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" } }
|
||||
|
74
gcc/testsuite/gfortran.dg/default_format_1.inc
Normal file
74
gcc/testsuite/gfortran.dg/default_format_1.inc
Normal file
@ -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
|
@ -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" } }
|
||||
|
43
gcc/testsuite/gfortran.dg/default_format_2.inc
Normal file
43
gcc/testsuite/gfortran.dg/default_format_2.inc
Normal file
@ -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
|
21
gcc/testsuite/gfortran.dg/default_format_denormal_1.f90
Normal file
21
gcc/testsuite/gfortran.dg/default_format_denormal_1.f90
Normal file
@ -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" } }
|
19
gcc/testsuite/gfortran.dg/default_format_denormal_2.f90
Normal file
19
gcc/testsuite/gfortran.dg/default_format_denormal_2.f90
Normal file
@ -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" } }
|
Loading…
Reference in New Issue
Block a user