Mercurial > hg > CbC > CbC_gcc
view gcc/testsuite/gfortran.dg/typebound_assignment_7.f90 @ 145:1830386684a0
gcc-9.2.0
author | anatofuz |
---|---|
date | Thu, 13 Feb 2020 11:34:05 +0900 |
parents | 84e7813d76e9 |
children |
line wrap: on
line source
! { dg-do run } ! ! PR 57843: [OOP] Type-bound assignment is resolved to non-polymorphic procedure call ! ! Contributed by John <jwmwalrus@gmail.com> module mod1 implicit none type :: itemType contains procedure :: the_assignment => assign_itemType generic :: assignment(=) => the_assignment end type contains subroutine assign_itemType(left, right) class(itemType), intent(OUT) :: left class(itemType), intent(IN) :: right end subroutine end module module mod2 use mod1 implicit none type, extends(itemType) :: myItem character(3) :: name = '' contains procedure :: the_assignment => assign_myItem end type contains subroutine assign_myItem(left, right) class(myItem), intent(OUT) :: left class(itemType), intent(IN) :: right select type (right) type is (myItem) left%name = right%name end select end subroutine end module program test_assign use mod2 implicit none class(itemType), allocatable :: item1, item2 allocate (myItem :: item1) select type (item1) type is (myItem) item1%name = 'abc' end select allocate (myItem :: item2) item2 = item1 select type (item2) type is (myItem) if (item2%name /= 'abc') STOP 1 class default STOP 2 end select end