Skip to content

R
riscv-gcc-1
Commit ce2a7a94 by Francois-Xavier Coudert Committed by François-Xavier Coudert
Options

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
parent 2f09ef38
Showing with 177 additions and 126 deletions
gcc/testsuite/ChangeLog
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> 2007-10-06 Jerry DeLisle <jvdelisle@gcc.gnu.org>
* gfortran.dg/namelist_15.f90: Revise test. * gfortran.dg/namelist_15.f90: Revise test.
gcc/testsuite/gfortran.dg/default_format_1.f90
! { dg-do run { xfail *-apple-darwin* } } ! { dg-do run }
! Test XFAILed on Darwin because the system's printf() lacks ! Test XFAILed on Darwin because the system's printf() lacks
! proper support for denormals. ! proper support for denormals.
! !
...@@ -6,98 +6,24 @@ ...@@ -6,98 +6,24 @@
! wide enough and have enough precision, by checking that values can ! wide enough and have enough precision, by checking that values can
! be written and read back. ! be written and read back.
! !
module test_default_format include "default_format_1.inc"
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 program main
use test_default_format use test_default_format
if (test (1.0_4, 0) /= 0) call abort if (test (1.0_4, 0) /= 0) call abort
if (test (0.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), 1) /= 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 (huge(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 (-huge(0.0_4), 1) /= 0) call abort
if (test (1.0_8, 0) /= 0) call abort if (test (1.0_8, 0) /= 0) call abort
if (test (0.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), 1) /= 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 (huge(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 if (test (-huge(0.0_8), 1) /= 0) call abort
end program main end program main
! !
! { dg-final { cleanup-modules "test_default_format" } } ! { dg-final { cleanup-modules "test_default_format" } }
gcc/testsuite/gfortran.dg/default_format_1.inc 0 → 100644
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
gcc/testsuite/gfortran.dg/default_format_2.f90
...@@ -7,60 +7,17 @@ ...@@ -7,60 +7,17 @@
! wide enough and have enough precision, by checking that values can ! wide enough and have enough precision, by checking that values can
! be written and read back. ! be written and read back.
! !
module test_default_format include "default_format_2.inc"
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 program main
use test_default_format use test_default_format
if (test (1.0_kl, 0) /= 0) call abort if (test (1.0_kl, 0) /= 0) call abort
if (test (0.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), 1) /= 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 (huge(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 if (test (-huge(0.0_kl), 1) /= 0) call abort
end program main end program main
! !
! { dg-final { cleanup-modules "test_default_format" } } ! { dg-final { cleanup-modules "test_default_format" } }
gcc/testsuite/gfortran.dg/default_format_2.inc 0 → 100644
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
gcc/testsuite/gfortran.dg/default_format_denormal_1.f90 0 → 100644
! { 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" } }
gcc/testsuite/gfortran.dg/default_format_denormal_2.f90 0 → 100644
! { 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" } }
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment