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

["janus at gcc dot gnu.org" <gcc-bugzilla@gcc.gnu.org>]

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

janus at gcc dot gnu.org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
                 CC|                            |janus at gcc dot gnu.org

--- Comment #2 from janus at gcc dot gnu.org ---
(In reply to John from comment #0)
> The code below does not do what's expected when compiled with gfortran-4.9
> (i.e., to print "this is right" instead of "what am I doing here?" every
> time the polymorphic assignment is invoked, and also printing the assigned
> values at the end, instead of the default ones.
> 
> Maybe I still don't understand the semantics behind Fortran 2003+'s
> type-bound assignment (so I apologize in advance if this is not a bug), but
> it seems to me that the assign_itemType procedure is being used for
> assignment, even though it doesn't satisfy the requirement of exact type for
> the "right" argument ---is polymorphism being resolved at compile time even
> for dynamic cases?

Well, what is resolved at compile time is the generic assignment (in the same
sense as any generic procedure is resolved to a matching specific procedure at
compile time, be it type-bound or not). Therefore I would say that the output
of your code is correct according to the Fortran 2003 standard, and just your
expectations are a bit off ;)

I tried to cook the test case down a bit, in order to make it a bit easier to
understand:


module mod1
  implicit none
  type :: itemType
  contains
    procedure :: assign_itemType
    generic :: assignment(=) => assign_itemType
  end type
contains
  subroutine assign_itemType(left, right)
    class(itemType), intent(OUT) :: left
    type(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 :: assign_myItem
    generic :: assignment(=) => assign_myItem
  end type
contains
  subroutine assign_myItem(left, right)
    class(myItem), intent(OUT) :: left
    type(myItem), intent(IN) :: right
    print *, 'this is right'
    left%name = right%name
  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


I get the same (supposedly correct) output with 4.8 and trunk:

item 1
 setting...
 table is same type as item?: T
 table is same type as itemType?: F
 table extends type itemType?: T

item 2
 setting...
 table is same type as aux?: T
 what am I doing here?
 what am I doing here?
 table is same type as item?: T
 table is same type as itemType?: F
 table extends type itemType?: T
           1    
           2


while 4.7 gives a runtime error:

item 1
 setting...
 table is same type as item?: T
 table is same type as itemType?: F
 table extends type itemType?: T

item 2
At line 80 of file test_assign.f90
Fortran runtime error: Attempting to allocate already allocated variable 'item'