gcc/testsuite/gfortran.dg/interface_assignment_3.f90

   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 !
   8 module 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
  21 contains
  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
  31 end module mo_memory
  32
  33 module 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
  39 contains
  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
  47 end module gfcbug74