gcc/testsuite/gfortran.dg/function_kinds_4.f90

   1 ! { dg-do run }
   2 ! Tests the fix for PR34471 in which function KINDs that were
   3 ! USE associated would cause an error.
   4 !
   5 ! This only needs to be run once.
   6 ! { dg-options "-O2" }
   7 !
   8 ! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
   9 !
  10 module m1
  11   integer, parameter :: i1 = 1, i2 = 2
  12 end module m1
  13
  14 module m2
  15   integer, parameter :: i1 = 8
  16 end module m2
  17
  18 integer(i1) function three()
  19   use m1, only: i2
  20   use m2                ! This provides the function kind
  21   three = i1
  22   if(three /= kind(three)) call abort()
  23 end function three
  24
  25 ! At one stage during the development of the patch, this started failing
  26 ! but was not tested in gfortran.dg.  */
  27 real (kind(0d0)) function foo ()
  28   foo = real (kind (foo))
  29 end function
  30
  31 program main
  32 implicit none
  33  interface
  34     integer(8) function three()
  35     end function three
  36  end interface
  37  integer, parameter :: i1 = 4
  38  integer :: i
  39  real (kind(0d0)) foo
  40  i = one()
  41  i = two()
  42  if(three() /= 8) call abort()
  43  if (int(foo()) /= 8) call abort ()
  44 contains
  45  integer(i1) function one()  ! Host associated kind
  46    if (kind(one) /= 4) call abort()
  47    one = 1
  48  end function one
  49  integer(i1) function two()  ! Use associated kind
  50    use m1, only: i2
  51    use m2
  52    if (kind(two) /= 8) call abort()
  53    two = 1
  54  end function two
  55 end program main
  56 ! { dg-final { cleanup-modules "m1 m2" } }