http://gcc.gnu.org/bugzilla/show_bug.cgi?id=57843
janus at gcc dot gnu.org changed:
What |Removed |Added
----------------------------------------------------------------------------
Status|UNCONFIRMED |NEW
Last reconfirmed| |2013-08-20
Ever confirmed|0 |1
--- Comment #4 from janus at gcc dot gnu.org ---
(In reply to janus from comment #3)
> Unfortunately it gives the same output as comment 2, which I think may
> indeed be a bug in gfortran!
Looking at the dump produced by -fdump-tree-original, it seems the problem is
that the assignments are translated into static calls to 'assign_itemtype'
instead of polymorphic calls to 'table._vptr->the_assignment (...)'.
I also checked that the problem seems to be specific to the assignment
operator. Using a generic type-bound procedure 'assign' (as below) gives the
expected output:
module mod1
implicit none
type :: itemType
contains
procedure :: the_assignment => assign_itemType
generic :: assign => 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
call table(j)%assign(aux(j))
enddo
call table(n+1)%assign(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
Here the output is:
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
this is right
this is right
table is same type as item?: T
table is same type as itemType?: F
table extends type itemType?: T
1 abc
2 abc
