gcc/testsuite/gfortran.dg/defined_assignment_5.f90

   1 ! { dg-do run }
   2 ! Further test of typebound defined assignment
   3 !
   4 module m0
   5   implicit none
   6   type component
   7     integer :: i = 0
   8   contains
   9     procedure :: assign0
  10     generic :: assignment(=)=>assign0
  11   end type
  12   type parent
  13     type(component) :: foo(2)
  14   end type
  15   type, extends(parent) :: child
  16     integer :: j
  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 module m1
  27   implicit none
  28   type component1
  29     integer :: i = 0
  30   contains
  31     procedure :: assign1
  32     generic :: assignment(=)=>assign1
  33   end type
  34   type parent1
  35     type(component1) :: foo
  36   end type
  37   type, extends(parent1) :: child1
  38     integer :: j = 7
  39   end type
  40 contains
  41   impure elemental subroutine assign1(lhs,rhs)
  42     class(component1), intent(out) :: lhs
  43     class(component1), intent(in) :: rhs
  44     lhs%i = 30
  45   end subroutine
  46 end module
  47
  48
  49 program main
  50   use m0
  51   use m1
  52   implicit none
  53   type(child) :: infant(2)
  54   type(parent) :: dad, mum
  55   type(child1) :: orphan(5)
  56   type(child1), allocatable :: annie(:)
  57   integer :: i, j, k
  58
  59   dad = parent ([component (3), component (4)])
  60   mum = parent ([component (5), component (6)])
  61   infant = [child(dad, 999), child(mum, 9999)]  ! { dg-warning "multiple part array references" }
  62
  63 ! Check that array sections are OK
  64   i = 3
  65   j = 4
  66   orphan(i:j) = child1(component1(777), 1)
  67   if (any (orphan%parent1%foo%i .ne. [0,0,30,30,0])) call abort
  68   if (any (orphan%j .ne. [7,7,1,1,7])) call abort
  69
  70 ! Check that allocatable lhs's work OK.
  71   annie = [(child1(component1(k), 2*k), k = 1,3)]
  72   if (any (annie%parent1%foo%i .ne. [30,30,30])) call abort
  73   if (any (annie%j .ne. [2,4,6])) call abort
  74 end
  75
  76