[Bug fortran/78737] [OOP] linking error with deferred, undefined user-defined derived-type I/O

[pault at gcc dot gnu.org]

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

--- Comment #9 from Paul Thomas <pault at gcc dot gnu.org> ---
Created attachment 40302
  --> https://gcc.gnu.org/bugzilla/attachment.cgi?id=40302&action=edit
A workaround for the PR (even a patch?)

The attached allows this testcase to run as intended:

! { dg-do run }
!
! Test the fix for PR78737. This is a development of the testscase
! in comment #6, which runs as intended.
!
! Contributed by Damian Rouson  <damian@sourceryinstitute.org>
!
module object_interface
  type, abstract :: object
  contains
    procedure(write_formatted), deferred :: write_formatted
    generic :: write(formatted) => write_formatted
  end type

! First extended type
  type, extends(object) :: non_abstract_child1
    integer :: i
  contains
! Point write_formatted to a specific procedure
    procedure :: write_formatted => write_formatted1
  end type

! Second extended type
  type, extends(object) :: non_abstract_child2
    real :: r
  contains
! Use the instantiation of the generic name
    procedure :: write_formatted
  end type

! Third extended type
  type, extends(object) :: non_abstract_child3
    character(3) :: c
  contains
! Use the instantiation of the generic name
    procedure :: write_formatted
  end type

contains
  subroutine write_formatted1(this,unit,iotype,vlist,iostat,iomsg)
    class(non_abstract_child1), 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
    if (this%i .ne. 99) call abort
  end subroutine

  subroutine write_formatted(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
    select type (this)
      class is (non_abstract_child1)
        if (this%i .ne. 99) call abort
      class is (non_abstract_child2)
        if (abs (this%r - 3.14159274) .gt. 1.0e-6) call abort
      class is (non_abstract_child3)
        if (this%c .ne. "abc") call abort
    end select
  end subroutine

  subroutine assert(a)
    class(object):: a
    select type (a)
      class is (non_abstract_child1)
        write(*,*) a
      class default
        write(*,*) a
    end select
  end subroutine
end module

  use object_interface
  class(object), allocatable :: z
  allocate (z, source = non_abstract_child1 (99))
  call assert (z)
  write (*,*) z
  deallocate (z)
  allocate (z, source = non_abstract_child2 (2.0*acos(0.0)))
  call assert (z)
  write (*,*) z
  deallocate (z)
  allocate (z, source = non_abstract_child3 ("abc"))
  call assert (z)
  write (*,*) z
end

Boostraps and regtests OK.

Paul