Mercurial > hg > CbC > CbC_gcc
view gcc/testsuite/gfortran.dg/ptr_func_assign_3.f08 @ 158:494b0b89df80 default tip
...
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Mon, 25 May 2020 18:13:55 +0900 |
parents | 84e7813d76e9 |
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