1! { dg-do run } 2! Test the fix for PR46897. 3! 4! Contributed by Rouson Damian <rouson@sandia.gov> 5! 6module m0 7 implicit none 8 type component 9 integer :: i = 0 10 contains 11 procedure :: assign0 12 generic :: assignment(=)=>assign0 13 end type 14 type parent 15 type(component) :: foo 16 end type 17 type, extends(parent) :: child 18 integer :: j 19 end type 20contains 21 subroutine assign0(lhs,rhs) 22 class(component), intent(out) :: lhs 23 class(component), intent(in) :: rhs 24 lhs%i = 20 25 end subroutine 26 type(child) function new_child() 27 end function 28end module 29 30module m1 31 implicit none 32 type component1 33 integer :: i = 1 34 contains 35 procedure :: assign1 36 generic :: assignment(=)=>assign1 37 end type 38 type t 39 type(component1) :: foo 40 end type 41contains 42 subroutine assign1(lhs,rhs) 43 class(component1), intent(out) :: lhs 44 class(component1), intent(in) :: rhs 45 lhs%i = 21 46 end subroutine 47end module 48 49module m2 50 implicit none 51 type component2 52 integer :: i = 2 53 end type 54 interface assignment(=) 55 module procedure assign2 56 end interface 57 type t2 58 type(component2) :: foo 59 end type 60contains 61 subroutine assign2(lhs,rhs) 62 type(component2), intent(out) :: lhs 63 type(component2), intent(in) :: rhs 64 lhs%i = 22 65 end subroutine 66end module 67 68program main 69 use m0 70 use m1 71 use m2 72 implicit none 73 type(child) :: infant0 74 type(t) :: infant1, newchild1 75 type(t2) :: infant2, newchild2 76 77! Test the reported problem. 78 infant0 = new_child() 79 if (infant0%parent%foo%i .ne. 20) call abort 80 81! Test the case of comment #1 of the PR. 82 infant1 = newchild1 83 if (infant1%foo%i .ne. 21) call abort 84 85! Test the case of comment #2 of the PR. 86 infant2 = newchild2 87 if (infant2%foo%i .ne. 2) call abort 88end 89 90 91