diff options
Diffstat (limited to 'gcc/testsuite/gfortran.dg/large_real_kind_1.f90')
-rw-r--r-- | gcc/testsuite/gfortran.dg/large_real_kind_1.f90 | 79 |
1 files changed, 79 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/large_real_kind_1.f90 b/gcc/testsuite/gfortran.dg/large_real_kind_1.f90 new file mode 100644 index 000000000..28e406730 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/large_real_kind_1.f90 @@ -0,0 +1,79 @@ +! { 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" } } |