1! { dg-do run }
2!
3! Tests corrections to implementation of pointer function assignments.
4!
5! Contributed by Mikael Morin  <mikael.morin@sfr.fr>
6!
7module m
8  implicit none
9  type dt
10    integer :: data
11  contains
12    procedure assign_dt
13    generic :: assignment(=) => assign_dt
14  end type
15contains
16  subroutine assign_dt(too, from)
17    class(dt), intent(out) :: too
18    type(dt), intent(in) :: from
19    too%data = from%data + 1
20  end subroutine
21end module m
22
23program p
24  use m
25  integer, parameter :: b = 3
26  integer, target    :: a = 2
27  type(dt), target :: tdt
28  type(dt) :: sdt = dt(1)
29
30  func (arg=b) = 1         ! This was rejected as an unclassifiable statement
31  if (a /= 1) STOP 1
32
33  func (b + b - 3) = -1
34  if (a /= -1) STOP 2
35
36  dtfunc () = sdt          ! Check that defined assignment is resolved
37  if (tdt%data /= 2) STOP 3
38contains
39  function func(arg) result(r)
40    integer, pointer :: r
41    integer :: arg
42    if (arg == 3) then
43      r => a
44    else
45      r => null()
46    end if
47  end function func
48  function dtfunc() result (r)
49    type(dt), pointer :: r
50    r => tdt
51  end function
52end program p
53