gcc/testsuite/gfortran.dg/defined_assignment_3.f90

   1 ! { dg-do run }
   2 ! Test the fix for PR46897. defined_assignment_1.f90 checks that the PR
   3 ! testcases run correctly, this checks array components are OK.
   4 !
   5 module m0
   6   implicit none
   7   type component
   8     integer :: i = 0
   9   contains
  10     procedure :: assign0
  11     generic :: assignment(=)=>assign0
  12   end type
  13   type parent
  14     type(component) :: foo(2)
  15   end type
  16   type, extends(parent) :: child
  17     integer :: j
  18   end type
  19 contains
  20   impure elemental subroutine assign0(lhs,rhs)
  21     class(component), intent(out) :: lhs
  22     class(component), intent(in) :: rhs
  23     lhs%i = 20
  24   end subroutine
  25 end module
  26
  27
  28 program main
  29   use m0
  30   implicit none
  31   type(child) :: infant0, infant1(2)
  32
  33   infant0 = child([component(1),component(2)], 99)
  34   if (any (infant0%parent%foo%i .ne. [20, 20])) call abort
  35
  36 end
  37
  38