1! { dg-do compile }
2! Checks the fix for PR34008, in which INTENT(INOUT) was disallowed
3! for the first argument of assign_m, whereas both INOUT and OUT
4! should be allowed.
5!
6! Contributed by Harald Anlauf <anlauf@gmx.de>
7!
8module mo_memory
9  implicit none
10  type t_mi
11     logical       :: alloc = .false.
12  end type t_mi
13  type t_m
14     type(t_mi)    :: i                         ! meta data
15     real, pointer :: ptr (:,:,:,:) => NULL ()
16  end type t_m
17
18  interface assignment (=)
19     module  procedure assign_m
20  end interface
21contains
22  elemental subroutine assign_m (y, x)
23    !---------------------------------------
24    ! overwrite intrinsic assignment routine
25    !---------------------------------------
26    type (t_m), intent(inout) :: y
27    type (t_m), intent(in)    :: x
28    y% i = x% i
29    if (y% i% alloc) y% ptr = x% ptr
30  end subroutine assign_m
31end module mo_memory
32
33module gfcbug74
34  use mo_memory, only: t_m, assignment (=)
35  implicit none
36  type t_atm
37     type(t_m) :: m(42)
38  end type t_atm
39contains
40  subroutine assign_atm_to_atm (y, x)
41    type (t_atm), intent(inout) :: y
42    type (t_atm), intent(in)    :: x
43    integer :: i
44!   do i=1,42; y% m(i) = x% m(i); end do    ! Works
45    y% m = x% m                             ! ICE
46  end subroutine assign_atm_to_atm
47end module gfcbug74
48