host_assoc_function_3.f90

来自「用于进行gcc测试」· F90 代码 · 共 28 行

! { dg-do run }
! Tests the fix for the bug PR33233, in which the reference to 'x'
! in 'inner' wrongly host-associated with the variable 'x' rather
! than the function.
!
! Contributed by Tobias Burnus <[e-mail]>
!
MODULE m
  REAL :: x(3) = (/ 1.5, 2.5, 3.5 /)
CONTAINS
  SUBROUTINE s
    if (x(2) .eq. 2.5) call abort ()
  CONTAINS
    FUNCTION x(n, m)
      integer, optional :: m
      if (present(m)) then
        x = REAL(n)**m
      else
        x = 0.0
      end if
    END FUNCTION
  END SUBROUTINE s
END MODULE m
  use m
  call s
end
! { dg-final { cleanup-modules "m" } }