! { dg-do run } ! ! Tests corrections to implementation of pointer function assignments. ! ! Contributed by Mikael Morin ! module m implicit none type dt integer :: data contains procedure assign_dt generic :: assignment(=) => assign_dt end type contains subroutine assign_dt(too, from) class(dt), intent(out) :: too type(dt), intent(in) :: from too%data = from%data + 1 end subroutine end module m program p use m integer, parameter :: b = 3 integer, target :: a = 2 type(dt), target :: tdt type(dt) :: sdt = dt(1) func (arg=b) = 1 ! This was rejected as an unclassifiable statement if (a /= 1) STOP 1 func (b + b - 3) = -1 if (a /= -1) STOP 2 dtfunc () = sdt ! Check that defined assignment is resolved if (tdt%data /= 2) STOP 3 contains function func(arg) result(r) integer, pointer :: r integer :: arg if (arg == 3) then r => a else r => null() end if end function func function dtfunc() result (r) type(dt), pointer :: r r => tdt end function end program p