gcc/testsuite/gfortran.dg/defined_assignment_9.f90

   1 ! { dg-do run }
   2 !
   3 ! PR fortran/57697
   4 !
   5 ! Further test of typebound defined assignment
   6 !
   7 module m0
   8   implicit none
   9   type component
  10     integer :: i = 42
  11   contains
  12     procedure :: assign0
  13     generic :: assignment(=) => assign0
  14   end type
  15   type parent
  16     type(component) :: foo
  17   end type
  18 contains
  19   elemental subroutine assign0(lhs,rhs)
  20     class(component), intent(INout) :: lhs
  21     class(component), intent(in) :: rhs
  22     lhs%i = 20
  23   end subroutine
  24 end module
  25
  26 program main
  27   use m0
  28   implicit none
  29   block
  30     type(parent), allocatable :: left
  31     type(parent) :: right
  32 !    print *, right%foo
  33     left = right
  34 !    print *, left%foo
  35     if (left%foo%i /= 20) call abort()
  36   end block
  37   block
  38     type(parent), allocatable :: left(:)
  39     type(parent) :: right(5)
  40 !    print *, right%foo
  41     left = right
  42 !    print *, left%foo
  43     if (any (left%foo%i /= 20)) call abort()
  44   end block
  45 end