https://gcc.gnu.org/bugzilla/show_bug.cgi?id=78737

--- Comment #18 from janus at gcc dot gnu.org ---
(In reply to Paul Thomas from comment #15)
> See this further example, which works with the last version of the patch.

Here is another runtime example, which in contrast to comment #15 does not
utilize any SELECT TYPE workaround:


module object_interface
  type :: object
  contains
    procedure :: write_formatted => write_formatted1
    generic :: write(formatted) => write_formatted
  end type
  type, extends(object) :: child
    integer :: i
  contains
    procedure :: write_formatted => write_formatted2
  end type
contains
  subroutine write_formatted1(this,unit,iotype,vlist,iostat,iomsg)
    class(object), intent(in) :: this
    integer, intent(in) :: unit
    character (len=*), intent(in) :: iotype
    integer, intent(in) :: vlist(:)
    integer, intent(out) :: iostat
    character (len=*), intent(inout) :: iomsg
    print '(a)', "write_formatted1"
  end subroutine
  subroutine write_formatted2(this,unit,iotype,vlist,iostat,iomsg)
    class(child), intent(in) :: this
    integer, intent(in) :: unit
    character (len=*), intent(in) :: iotype
    integer, intent(in) :: vlist(:)
    integer, intent(out) :: iostat
    character (len=*), intent(inout) :: iomsg
    print '(a,i4/)', "write_formatted2 => ", this%i
  end subroutine
  subroutine assert(a)
    class(object):: a
    write(*,*) a
  end subroutine
end module

  use object_interface
  call assert (object ())
  call assert (child (99))
end


It currently prints (i.e. with Paul's latest patch and probably also with a
clean trunk):

 write_formatted1
 write_formatted1

I.e. both calls to assert result in the same DTIO procedure, although the type
of the argument differs (and the extended type overrides the DTIO procedure).
In my opinion the output should be:

 write_formatted1
 write_formatted2 =>   99

When looking at the dump of the generated code for the assert routine, one
currently sees:

assert (struct __class_object_interface_Object_t & restrict a)
{
  [...]
    _gfortran_transfer_derived (&dt_parm.0, (struct
__class_object_interface_Object_t *) a, write_formatted1);
  [...]
}

That is, we always call the DTIO procedure of the base type (write_formatted1).
IMHO this is wrong and the second argument of  _gfortran_transfer_derived
should rather be "a->_vptr->write_formatted", in order to call the correct DTIO
procedure of the dynamic type.

Reply via email to