[Bug fortran/57843] [OOP] Polymorphic assignment for derived type is resolved with parent's generic instead of its own

[janus at gcc dot gnu.org]

http://gcc.gnu.org/bugzilla/show_bug.cgi?id=57843

janus at gcc dot gnu.org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
            Summary|Polymorphic assignment for  |[OOP] Polymorphic
                   |derived type is resolved    |assignment for derived type
                   |with parent's generic       |is resolved with parent's
                   |instead of its own          |generic instead of its own

--- Comment #3 from janus at gcc dot gnu.org ---
Below is a modified test case, based on comment 2, which I think should do what
you were trying to accomplish. It binds the generic assignment to a type-bound
procedure 'the_assignment', which is overridden in the extended type:


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
    print *, 'what am I doing here?'
  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
    print *, 'this is right'
    select type (right)
    type is (myItem)
      left%name = right%name
    end select
  end subroutine
end module


program test_assign

  use mod2
  implicit none

  integer :: i, j, n
  class(itemType), allocatable :: table(:), item, aux(:)

  ! process
  do i = 1, 2
    print '(/,"item ",I0)', i
    call setItem('abc', item)

    if (ALLOCATED(table)) then
      n = SIZE(table)
      call MOVE_ALLOC(table, aux)
      allocate (table(n+1), MOLD = item)
      print *, 'table is same type as aux?:', SAME_TYPE_AS(table, aux)

      do j = 1, n
    table(j) = aux(j)
      enddo
      table(n+1) = item
    else
      allocate (table(1), SOURCE = item)
    endif
    print *, 'table is same type as item?:', SAME_TYPE_AS(table, item)
    print *, 'table is same type as itemType?:', SAME_TYPE_AS(table,
itemType())
    print *, 'table extends type itemType?:', EXTENDS_TYPE_OF(table,
itemType())
  enddo

  ! output
  do i = 1, SIZE(table)
    select type (item => table(i))
      type is (myItem)
    print *, i, item%name
    end select
  enddo

contains

  subroutine setItem(name, item)
    character(*), intent(IN) :: name
    class(itemType), allocatable, intent(OUT) :: item

    allocate (myItem :: item)
    select type (item)
      type is (myItem)
    print *, 'setting...'
    item%name = name
    end select
  end subroutine

end


Unfortunately it gives the same output as comment 2, which I think may indeed
be a bug in gfortran!