gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_sr_kind.f90

! Program to test SELECTED_REAL_KIND intrinsic function.
Program test_sr_kind
  integer res, i4, i8, t
  real*4 r4
  real*8 r8

  i4 = int (log10 (huge (r4)))
  t = - int (log10 (tiny (r4)))
  if (i4 .gt. t) i4 = t

  i8 = int (log10 (huge (r8)))
  t = - int (log10 (tiny (r8)))
  if (i8 .gt. t) i8 = t

  res = selected_real_kind (r = i4)
  if (res .ne. 4) STOP 1

  res = selected_real_kind (r = i8)
  if (res .ne. 8) STOP 2

! We can in fact have kinds wider than r8.  How do we want to check?
! res = selected_real_kind (r = (i8 + 1))
! if (res .ne. -2) STOP 3

  res = selected_real_kind (p = precision (r4))
  if (res .ne. 4) STOP 4

  res = selected_real_kind (p = precision (r4), r = i4)
  if (res .ne. 4) STOP 5

  res = selected_real_kind (p = precision (r4), r = i8)
  if (res .ne. 8) STOP 6

! res = selected_real_kind (p = precision (r4), r = i8 + 1)
! if (res .ne. -2) STOP 7

  res = selected_real_kind (p = precision (r8))
  if (res .ne. 8) STOP 8

  res = selected_real_kind (p = precision (r8), r = i4)
  if (res .ne. 8) STOP 9

  res = selected_real_kind (p = precision (r8), r = i8)
  if (res .ne. 8) STOP 10

! res = selected_real_kind (p = precision (r8), r = i8 + 1)
! if (res .ne. -2) STOP 11

! res = selected_real_kind (p = (precision (r8) + 1))
! if (res .ne. -1) STOP 12

! res = selected_real_kind (p = (precision (r8) + 1), r = i4)
! if (res .ne. -1) STOP 13

! res = selected_real_kind (p = (precision (r8) + 1), r = i8)
! if (res .ne. -1) STOP 14

! res = selected_real_kind (p = (precision (r8) + 1), r = i8 + 1)
! if (res .ne. -3) STOP 15

end