gcc/testsuite/gfortran.dg/defined_assignment_11.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     integer, allocatable :: b
  12   contains
  13     procedure :: assign0
  14     generic :: assignment(=) => assign0
  15   end type
  16   type, extends(component) :: comp2
  17     real :: aa
  18   end type comp2
  19   type parent
  20     type(component) :: foo
  21     real :: cc
  22   end type
  23   type p2
  24     type(parent) :: x
  25   end type p2
  26 contains
  27   elemental subroutine assign0(lhs,rhs)
  28     class(component), intent(INout) :: lhs
  29     class(component), intent(in) :: rhs
  30     lhs%i = 20
  31   end subroutine
  32 end module
  33
  34 program main
  35   use m0
  36   implicit none
  37   type(p2), allocatable :: left
  38   type(p2) :: right
  39 !  print *, right%x%foo%i
  40   left = right
  41 !  print *, left%x%foo%i
  42   if (left%x%foo%i /= 20) STOP 1
  43 end