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

["jwmwalrus at gmail dot com" <gcc-bugzilla at gcc dot gnu dot org>]

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

            Bug ID: 57843
           Summary: Polymorphic assignment for derived type is resolved
                    with parent's generic instead of its own
           Product: gcc
           Version: 4.9.0
            Status: UNCONFIRMED
          Severity: normal
          Priority: P3
         Component: fortran
          Assignee: unassigned at gcc dot gnu.org
          Reporter: jwmwalrus at gmail dot com

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?

By commenting out the line marked with "!*****", I get an ICE with ifort
13.1.3, so I have no way to compare behavior.



!-------------------------test_assign.f90
module mod1
    implicit none

    type :: itemType
    contains
        procedure :: assign_itemType
        generic :: assignment(=) => assign_itemType
    end type

    type, abstract :: tableType
        class(itemType), allocatable :: table(:)
    contains
        procedure :: process
        procedure(i_setItem), nopass, deferred :: setItem
    end type

    abstract interface
        subroutine i_setItem(array, item)
            import
            character(*), intent(IN) :: array(:)
            class(itemType), allocatable, intent(OUT) :: item
        end subroutine
    end interface

contains
    subroutine process(this)
        class(tableType), intent(INOUT) :: this
        integer :: i, j, n
        character(5), allocatable :: array(:)
        class(itemType), allocatable :: item, aux(:)

        do i = 1, 3
            print '(/,"item ",I0)', i
            array = [character(5) :: 'abc', '1', '12.3']
            call this%setItem(array, item)

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

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

    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 mod1

module mod2
    use mod1
    implicit none

    type, extends(itemType) :: myItem
        character(3) :: name = ''
        integer :: num = 0
        real :: val = 0
    contains
        procedure :: assign_myItem
        generic :: assignment(=) => assign_myItem
    end type

    type, extends(tableType) :: myTable
    contains
        procedure, nopass :: setItem
        procedure :: output
    end type

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

        allocate (myItem :: item)
        select type (item)
            type is (myItem)
                print *, 'setting...'
                item%name = array(1)
                read (array(2), *) item%num
                read (array(3), *) item%val
        end select
    end subroutine

    subroutine assign_myItem(left, right)
        class(myItem), intent(OUT) :: left
        type(myItem), intent(IN) :: right

        print *, 'this is right'
        left%name = right%name
        left%num = right%num
        left%val = right%val
    end subroutine

    subroutine output(this)
        class(myTable), intent(IN) :: this
        integer :: i

        do i = 1, SIZE(this%table)
            select type (item => this%table(i))
                type is (myItem)
                    print *, i, item%name, item%num, item%val
            end select
        enddo
    end subroutine
end module mod2

use mod2
implicit none

type(myTable) :: table
call table%process()
call table%output()
end
!-------------------------test_assign.f90



The output obtained is:

...:~$ gfortran-4.9 -std=f2008 test_assign.f90 
...:~$ ./a.out 

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

item 3
 setting...
 table is same type as aux?: T
 what am I doing here?
 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               0   0.00000000    
           2               0   0.00000000    
           3               0   0.00000000



The system info is:

...:~$ ll `which gfortran-4.9` && /usr/lib/gcc-snapshot/bin/gfortran -v &&
apt-cache policy gfortran-4.8 gcc-snapshot && lsb_release -rd
lrwxrwxrwx 1 root staff 34 Jul  5 12:58 /usr/local/bin/gfortran-4.9 ->
/usr/lib/gcc-snapshot/bin/gfortran*
Using built-in specs.
COLLECT_GCC=/usr/lib/gcc-snapshot/bin/gfortran
COLLECT_LTO_WRAPPER=/usr/lib/gcc-snapshot/libexec/gcc/x86_64-linux-gnu/4.9.0/lto-wrapper
Target: x86_64-linux-gnu
Configured with: ../src/configure -v --with-pkgversion='Debian 20130620-1'
--with-bugurl=file:///usr/share/doc/gcc-snapshot/README.Bugs
--enable-languages=c,ada,c++,java,go,fortran,objc,obj-c++
--prefix=/usr/lib/gcc-snapshot --enable-shared --enable-linker-build-id
--disable-nls --with-sysroot=/ --enable-clocale=gnu --enable-libstdcxx-debug
--enable-libstdcxx-time=yes --enable-gnu-unique-object --enable-plugin
--with-system-zlib --disable-browser-plugin --enable-java-awt=gtk
--enable-gtk-cairo
--with-java-home=/usr/lib/jvm/java-1.5.0-gcj-4.9-snap-amd64/jre
--enable-java-home
--with-jvm-root-dir=/usr/lib/jvm/java-1.5.0-gcj-4.9-snap-amd64
--with-jvm-jar-dir=/usr/lib/jvm-exports/java-1.5.0-gcj-4.9-snap-amd64
--with-arch-directory=amd64 --with-ecj-jar=/usr/share/java/eclipse-ecj.jar
--enable-objc-gc --enable-multiarch --with-arch-32=i586 --with-abi=m64
--with-multilib-list=m32,m64,mx32 --with-tune=generic --disable-werror
--enable-checking=yes --build=x86_64-linux-gnu --host=x86_64-linux-gnu
--target=x86_64-linux-gnu
Thread model: posix
gcc version 4.9.0 20130620 (experimental) [trunk revision 200244] (Debian
20130620-1) 
gfortran-4.8:
  Installed: 4.8.1-5
  Candidate: 4.8.1-5
  Version table:
 *** 4.8.1-5 0
        200 http://ftp.us.debian.org/debian/ unstable/main amd64 Packages
        100 /var/lib/dpkg/status
     4.8.1-2 0
        500 http://ftp.us.debian.org/debian/ testing/main amd64 Packages
gcc-snapshot:
  Installed: 20130620-1
  Candidate: 20130620-1
  Version table:
 *** 20130620-1 0
        200 http://ftp.us.debian.org/debian/ unstable/main amd64 Packages
        100 /var/lib/dpkg/status
Description:    Debian GNU/Linux testing (jessie)
Release:    testing