gcc/testsuite/gfortran.dg/host_assoc_function_1.f90

   1 ! { dg-do run }
   2 ! Tests the fix for the bug PR30746, in which the reference to 'x'
   3 ! in 'inner' wrongly host-associated with the variable 'x' rather
   4 ! than the function.
   5 !
   6 ! Testcase is due to Malcolm Cohen, NAG.
   7 !
   8 real function z (i)
   9   integer :: i
  10   z = real (i)**i
  11 end function
  12
  13 MODULE m
  14   REAL :: x(3) = (/ 1.5, 2.5, 3.5 /)
  15   interface
  16     real function z (i)
  17       integer :: i
  18     end function
  19   end interface
  20 CONTAINS
  21   SUBROUTINE s
  22     if (x(2) .ne. 2.5) call abort ()
  23     if (z(3) .ne. real (3)**3) call abort ()
  24     CALL inner
  25   CONTAINS
  26     SUBROUTINE inner
  27       i = 7
  28       if (x(i, 7) .ne. real (7)**7) call abort ()
  29       if (z(i, 7) .ne. real (7)**7) call abort ()
  30     END SUBROUTINE
  31     FUNCTION x(n, m)
  32       x = REAL(n)**m
  33     END FUNCTION
  34     FUNCTION z(n, m)
  35       z = REAL(n)**m
  36     END FUNCTION
  37
  38   END SUBROUTINE
  39 END MODULE
  40   use m
  41   call s()
  42 end
  43 ! { dg-final { cleanup-modules "m" } }