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

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

[jwmwalrus at gmail dot com]

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

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

[burnus at gcc dot gnu.org]

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

Tobias Burnus <burnus at gcc dot gnu.org> changed:

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

--- Comment #1 from Tobias Burnus <burnus 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.

I get the same result with Cray's ftn 8.1.8. (Except that it prints "1 @� 0, 
0." at the end - instead of "1 0 0.00000000"; that's most likely uninitialized
memory, possibly a bug in the crayftn compiler [or something else].)


> 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?

I believe the generic resolution (assignment, operator but also "generic") is
done at the compile time - which gives type bound procedure ("procedure ::
name"). The only run-time component is whether the type-bound procedure of the
basic type or of the extended type is called.

I have to admit that I haven't yet studied the test case to see whether there
is a problem or not.
>From gcc-bugs-return-425939-listarch-gcc-bugs=gcc.gnu.org@gcc.gnu.org Mon Jul 08 17:28:23 2013
Return-Path: <gcc-bugs-return-425939-listarch-gcc-bugs=gcc.gnu.org@gcc.gnu.org>
Delivered-To: listarch-gcc-bugs@gcc.gnu.org
Received: (qmail 31972 invoked by alias); 8 Jul 2013 17:28:23 -0000
Mailing-List: contact gcc-bugs-help@gcc.gnu.org; run by ezmlm
Precedence: bulk
List-Id: <gcc-bugs.gcc.gnu.org>
List-Archive: <http://gcc.gnu.org/ml/gcc-bugs/>
List-Post: <mailto:gcc-bugs@gcc.gnu.org>
List-Help: <mailto:gcc-bugs-help@gcc.gnu.org>
Sender: gcc-bugs-owner@gcc.gnu.org
Delivered-To: mailing list gcc-bugs@gcc.gnu.org
Received: (qmail 31926 invoked by uid 48); 8 Jul 2013 17:28:18 -0000
From: "ubizjak at gmail dot com" <gcc-bugzilla@gcc.gnu.org>
To: gcc-bugs@gcc.gnu.org
Subject: [Bug libgcc/57851] [patch] unwinding via signal trampoline for kfreebsd*-gnu
Date: Mon, 08 Jul 2013 17:28:00 -0000
X-Bugzilla-Reason: CC
X-Bugzilla-Type: changed
X-Bugzilla-Watch-Reason: None
X-Bugzilla-Product: gcc
X-Bugzilla-Component: libgcc
X-Bugzilla-Version: 4.9.0
X-Bugzilla-Keywords:
X-Bugzilla-Severity: enhancement
X-Bugzilla-Who: ubizjak at gmail dot com
X-Bugzilla-Status: UNCONFIRMED
X-Bugzilla-Priority: P3
X-Bugzilla-Assigned-To: unassigned at gcc dot gnu.org
X-Bugzilla-Target-Milestone: ---
X-Bugzilla-Flags:
X-Bugzilla-Changed-Fields:
Message-ID: <bug-57851-4-JKpdSde9Ac@http.gcc.gnu.org/bugzilla/>
In-Reply-To: <bug-57851-4@http.gcc.gnu.org/bugzilla/>
References: <bug-57851-4@http.gcc.gnu.org/bugzilla/>
Content-Type: text/plain; charset="UTF-8"
Content-Transfer-Encoding: quoted-printable
X-Bugzilla-URL: http://gcc.gnu.org/bugzilla/
Auto-Submitted: auto-generated
MIME-Version: 1.0
X-SW-Source: 2013-07/txt/msg00446.txt.bz2
Content-length: 503

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

--- Comment #1 from Uroš Bizjak <ubizjak at gmail dot com> ---
(In reply to Petr.Salinger from comment #0)
> Created attachment 30476 [details]
> proposed patch
> 
> Please add support for unwinding through signal handler for GNU/kFreeBSD.
> 
> The attached patch is tested on GNU/kFreeBSD, both 32-bit and 64-bit.
> The i386/freebsd-unwind.h is probably also suitable for plain FreeBSD.

Please post the patch to gcc-patches@ mailing list.
>From gcc-bugs-return-425940-listarch-gcc-bugs=gcc.gnu.org@gcc.gnu.org Mon Jul 08 18:44:00 2013
Return-Path: <gcc-bugs-return-425940-listarch-gcc-bugs=gcc.gnu.org@gcc.gnu.org>
Delivered-To: listarch-gcc-bugs@gcc.gnu.org
Received: (qmail 4414 invoked by alias); 8 Jul 2013 18:44:00 -0000
Mailing-List: contact gcc-bugs-help@gcc.gnu.org; run by ezmlm
Precedence: bulk
List-Id: <gcc-bugs.gcc.gnu.org>
List-Archive: <http://gcc.gnu.org/ml/gcc-bugs/>
List-Post: <mailto:gcc-bugs@gcc.gnu.org>
List-Help: <mailto:gcc-bugs-help@gcc.gnu.org>
Sender: gcc-bugs-owner@gcc.gnu.org
Delivered-To: mailing list gcc-bugs@gcc.gnu.org
Received: (qmail 4387 invoked by uid 48); 8 Jul 2013 18:43:56 -0000
From: "gjl at gcc dot gnu.org" <gcc-bugzilla@gcc.gnu.org>
To: gcc-bugs@gcc.gnu.org
Subject: [Bug target/57844] avr-unknown-elf libstdc++v3 build causes internal compiler error: in extract_insn, at recog.c:2150
Date: Mon, 08 Jul 2013 18:44:00 -0000
X-Bugzilla-Reason: CC
X-Bugzilla-Type: changed
X-Bugzilla-Watch-Reason: None
X-Bugzilla-Product: gcc
X-Bugzilla-Component: target
X-Bugzilla-Version: 4.8.1
X-Bugzilla-Keywords: ice-on-valid-code
X-Bugzilla-Severity: normal
X-Bugzilla-Who: gjl at gcc dot gnu.org
X-Bugzilla-Status: NEW
X-Bugzilla-Priority: P4
X-Bugzilla-Assigned-To: gjl at gcc dot gnu.org
X-Bugzilla-Target-Milestone: 4.8.2
X-Bugzilla-Flags:
X-Bugzilla-Changed-Fields: priority bug_status cf_reconfirmed_on cc assigned_to target_milestone everconfirmed
Message-ID: <bug-57844-4-j4sZ15zWNA@http.gcc.gnu.org/bugzilla/>
In-Reply-To: <bug-57844-4@http.gcc.gnu.org/bugzilla/>
References: <bug-57844-4@http.gcc.gnu.org/bugzilla/>
Content-Type: text/plain; charset="UTF-8"
Content-Transfer-Encoding: 7bit
X-Bugzilla-URL: http://gcc.gnu.org/bugzilla/
Auto-Submitted: auto-generated
MIME-Version: 1.0
X-SW-Source: 2013-07/txt/msg00447.txt.bz2
Content-length: 1466

http://gcc.gnu.org/bugzilla/show_bug.cgi?idW844

Georg-Johann Lay <gjl at gcc dot gnu.org> changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
           Priority|P3                          |P4
             Status|UNCONFIRMED                 |NEW
   Last reconfirmed|                            |2013-07-08
                 CC|                            |gjl at gcc dot gnu.org
           Assignee|unassigned at gcc dot gnu.org      |gjl at gcc dot gnu.org
   Target Milestone|---                         |4.8.2
     Ever confirmed|0                           |1

--- Comment #1 from Georg-Johann Lay <gjl at gcc dot gnu.org> ---
Here is a smaller test case:

void g (char*);

void f (void)
{
    char b[128];
    g (b);
}

Compile with

$ avr-gcc foo.c -c -msp8

foo.c: In function 'f':
foo.c:7:1: error: unrecognizable insn:
 }
 ^
(insn/f 16 15 17 (set (reg:QI 28 r28)
        (plus:QI (reg:QI 28 r28)
            (const_int 128 [0x80]))) foo.c:5 -1
     (expr_list:REG_CFA_ADJUST_CFA (set (reg/f:HI 28 r28)
            (plus:HI (reg/f:HI 28 r28)
                (const_int -128 [0xffffff80])))
        (nil)))
foo.c:7:1: internal compiler error: in insn_default_length, at
config/avr/avr.md:448

foo.c:7:1: internal compiler error: Segmentation fault

Problem is that 128 is not QI, should be -128.


--enable-libstdcxx vs. building libstdc++v3 is a different issue.

[Bug fortran/57843] 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
----------------------------------------------------------------------------
                 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'

[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!

[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
----------------------------------------------------------------------------
             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

[Bug fortran/57843] [OOP] Type-bound assignment is resolved to non-polymorphic procedure call

[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
----------------------------------------------------------------------------
           Keywords|                            |wrong-code
            Summary|[OOP] Polymorphic           |[OOP] Type-bound assignment
                   |assignment for derived type |is resolved to
                   |is resolved with parent's   |non-polymorphic procedure
                   |generic instead of its own  |call

--- Comment #5 from janus at gcc dot gnu.org ---
I think the problem lies in gfc_extend_assign (interface.c): We first try to
find a (non-typebound) assignment operator and only afterwards look for
type-bound assignments. Problem is: All typebound assignment procedures are
also being added to the list of normal assignment procedures (ns->op), because
they can also be used in a non-polymorphic fashion.

[Bug fortran/57843] [OOP] Type-bound assignment is resolved to non-polymorphic procedure call

[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
----------------------------------------------------------------------------
             Status|NEW                         |ASSIGNED
           Assignee|unassigned at gcc dot gnu.org      |janus at gcc dot gnu.org

--- Comment #6 from janus at gcc dot gnu.org ---
Created attachment 30678
  --> http://gcc.gnu.org/bugzilla/attachment.cgi?id=30678&action=edit
patch

This patch fixes the ordering in gfc_extend_assign and in this way repairs the
behavior on the code in comment 3.

[Bug fortran/57843] [OOP] Type-bound assignment is resolved to non-polymorphic procedure call

[janus at gcc dot gnu.org]

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

--- Comment #7 from janus at gcc dot gnu.org ---
(In reply to janus from comment #6)
> This patch fixes the ordering in gfc_extend_assign and in this way repairs
> the behavior on the code in comment 3.

... and regtests cleanly.

[Bug fortran/57843] [OOP] Type-bound assignment is resolved to non-polymorphic procedure call

[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
----------------------------------------------------------------------------
             Status|ASSIGNED                    |RESOLVED
         Resolution|---                         |FIXED

--- Comment #8 from janus at gcc dot gnu.org ---
Fixed with the commit below. Closing. Thanks for the report!


Author: janus
Date: Fri Aug 23 16:43:15 2013
New Revision: 201946

URL: http://gcc.gnu.org/viewcvs?rev=201946&root=gcc&view=rev
Log:
2013-08-23  Janus Weil  <janus@gcc.gnu.org>

    PR fortran/57843
    * interface.c (gfc_extend_assign): Look for type-bound assignment
    procedures before non-typebound.


2013-08-23  Janus Weil  <janus@gcc.gnu.org>

    PR fortran/57843
    * gfortran.dg/typebound_assignment_7.f90: New.

Added:
    trunk/gcc/testsuite/gfortran.dg/typebound_assignment_7.f90
Modified:
    trunk/gcc/fortran/ChangeLog
    trunk/gcc/fortran/interface.c
    trunk/gcc/testsuite/ChangeLog