Mercurial > hg > CbC > CbC_gcc
view gcc/testsuite/gfortran.dg/ptr_func_assign_3.f08 @ 131:84e7813d76e9
gcc-8.2
author | mir3636 |
---|---|
date | Thu, 25 Oct 2018 07:37:49 +0900 |
parents | 04ced10e8804 |
children |
line wrap: on
line source
! { dg-do run } ! ! Tests corrections to implementation of pointer function assignments. ! ! Contributed by Mikael Morin <mikael.morin@sfr.fr> ! 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