gcc/testsuite/gfortran.dg/iso_fortran_env_7.f90

   1 ! { dg-do link }
   2 !
   3 ! PR fortran/40571
   4 !
   5 ! This test case adds check for the new Fortran 2008 array parameters
   6 ! in ISO_FORTRAN_ENV: integer_kinds, logical_kinds, character_kinds,
   7 ! and real_kinds.
   8 !
   9 ! The test thus also checks that the values of the parameter are used
  10 ! and no copy is made. (Cf. PR 44856.)
  11
  12 program test
  13   use iso_fortran_env, only: integer_kinds, character_kinds
  14   implicit none
  15   integer :: aaaa(2),i
  16   i=1
  17
  18   print *, integer_kinds
  19   print *, integer_kinds(1)
  20   print *, (integer_kinds)
  21   print *, (integer_kinds + 1)
  22   print *, integer_kinds(1:2)
  23   print *, integer_kinds(i)
  24
  25   aaaa = character_kinds
  26   aaaa(1:2) = character_kinds(1:2)
  27   aaaa(i) = character_kinds(i)
  28   aaaa = character_kinds + 0
  29   aaaa(1:2) = character_kinds(1:2) + 0
  30   aaaa(i) = character_kinds(i) + 0
  31 end program test
  32
  33 subroutine one()
  34   use iso_fortran_env, only: ik => integer_kinds, ik2 => integer_kinds
  35   implicit none
  36
  37   if (any (ik /= ik2)) call never_call_me()
  38 end subroutine one
  39
  40 subroutine two()
  41   use iso_fortran_env
  42   implicit none
  43
  44   ! Should be 1, 2, 4, 8 and possibly 16
  45   if (size (integer_kinds) < 4) call never_call_me()
  46   if (any (integer_kinds(1:4) /= [1,2,4,8])) call never_call_me()
  47   if (any (integer_kinds /= logical_kinds)) call never_call_me()
  48
  49   if (size (character_kinds) /= 2) call never_call_me()
  50   if (any (character_kinds /= [1,4])) call never_call_me()
  51
  52   if (size (real_kinds) < 2) call never_call_me()
  53   if (any (real_kinds(1:2) /= [4,8])) call never_call_me()
  54 end subroutine two
  55
  56 subroutine three()
  57   use iso_fortran_env
  58   integer :: i, j(2)
  59   i = real_kinds(1)
  60   j = real_kinds(1:2)
  61 end subroutine three