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!
