summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg/large_real_kind_1.f90
blob: 28e406730fa3aac74e6e9b660924ec08525cc9a8 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
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" } }