Subversion Repositories openrisc

! { dg-do run }

! { dg-require-effective-target fortran_large_real }

module testmod

  integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)

contains

  subroutine testoutput (a,b,length,f)

    real(kind=k),intent(in) :: a

    real(kind=8),intent(in) ::  b

    integer,intent(in) :: length

    character(len=*),intent(in) :: f

    character(len=length) :: ca

    character(len=length) :: cb

    write (ca,f) a

    write (cb,f) b

    if (ca /= cb) call abort

  end subroutine testoutput

  subroutine outputstring (a,f,s)

    real(kind=k),intent(in) :: a

    character(len=*),intent(in) :: f

    character(len=*),intent(in) :: s

    character(len=len(s)) :: c

    write (c,f) a

    if (c /= s) call abort

  end subroutine outputstring

end module testmod

! Testing I/O of large real kinds (larger than kind=8)

program test

  use testmod

  implicit none

  real(kind=k) :: x

  character(len=20) :: c1, c2

  call testoutput (0.0_k,0.0_8,40,'(F40.35)')

  call testoutput (1.0_k,1.0_8,40,'(F40.35)')

  call testoutput (0.1_k,0.1_8,15,'(F15.10)')

  call testoutput (1e10_k,1e10_8,15,'(F15.10)')

  call testoutput (7.51e100_k,7.51e100_8,15,'(F15.10)')

  call testoutput (1e-10_k,1e-10_8,15,'(F15.10)')

  call testoutput (7.51e-100_k,7.51e-100_8,15,'(F15.10)')

  call testoutput (-1.0_k,-1.0_8,40,'(F40.35)')

  call testoutput (-0.1_k,-0.1_8,15,'(F15.10)')

  call testoutput (-1e10_k,-1e10_8,15,'(F15.10)')

  call testoutput (-7.51e100_k,-7.51e100_8,15,'(F15.10)')

  call testoutput (-1e-10_k,-1e-10_8,15,'(F15.10)')

  call testoutput (-7.51e-100_k,-7.51e-100_8,15,'(F15.10)')

  x = huge(x)

  call outputstring (2*x,'(F20.15)','            Infinity')

  call outputstring (-2*x,'(F20.15)','           -Infinity')

  write (c1,'(G20.10E5)') x

  write (c2,'(G20.10E5)') -x

  if (c2(1:1) /= '-') call abort

  c2(1:1) = ' '

  if (c1 /= c2) call abort

  x = tiny(x)

  call outputstring (x,'(F20.15)','   0.000000000000000')

  call outputstring (-x,'(F20.15)','  -0.000000000000000')

  write (c1,'(G20.10E5)') x

  write (c2,'(G20.10E5)') -x

  if (c2(1:1) /= '-') call abort

  c2(1:1) = ' '

  if (c1 /= c2) call abort

end program test

! { dg-final { cleanup-modules "testmod" } }