gcc/testsuite/gfortran.dg/typebound_assignment_7.f90

! { 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