gcc/testsuite/gfortran.dg/default_format_2.inc

   1 module test_default_format
   2   interface test
   3     module procedure test_rl
   4   end interface test
   5
   6   integer, parameter :: kl = selected_real_kind (precision (0.0_8) + 1)
   7   integer, parameter :: count = 200
   8
   9 contains
  10
  11   function test_rl (start, towards) result (res)
  12     integer, parameter :: k = kl
  13     integer, intent(in) :: towards
  14     real(k), intent(in) :: start
  15
  16     integer :: res, i
  17     real(k) :: x, y
  18     character(len=100) :: s
  19
  20     res = 0
  21
  22     if (towards >= 0) then
  23       x = start
  24       do i = 0, count
  25         write (s,*) x
  26         read (s,*) y
  27         if (y /= x) res = res + 1
  28         x = nearest(x,huge(x))
  29       end do
  30     end if
  31
  32     if (towards <= 0) then
  33       x = start
  34       do i = 0, count
  35         write (s,*) x
  36         read (s,*) y
  37         if (y /= x) res = res + 1
  38         x = nearest(x,-huge(x))
  39       end do
  40     end if
  41   end function test_rl
  42
  43 end module test_default_format