gcc/testsuite/gfortran.dg/dtio_19.f90

   1 ! { dg-do run }
   2 !
   3 ! PR78737: [OOP] linking error with deferred, undefined user-defined derived-type I/O
   4 !
   5 ! Contributed by Damian Rouson  <damian@sourceryinstitute.org>
   6
   7 module object_interface
   8   character(30) :: buffer(2)
   9   type, abstract :: object
  10   contains
  11     procedure(write_formatted_interface), deferred :: write_formatted
  12     generic :: write(formatted) => write_formatted
  13   end type
  14   abstract interface
  15     subroutine write_formatted_interface(this,unit,iotype,vlist,iostat,iomsg)
  16       import object
  17       class(object), intent(in) :: this
  18       integer, intent(in) :: unit
  19       character (len=*), intent(in) :: iotype
  20       integer, intent(in) :: vlist(:)
  21       integer, intent(out) :: iostat
  22       character (len=*), intent(inout) :: iomsg
  23     end subroutine
  24   end interface
  25   type, extends(object) :: non_abstract_child1
  26     integer :: i
  27   contains
  28     procedure :: write_formatted => write_formatted1
  29   end type
  30   type, extends(object) :: non_abstract_child2
  31     real :: r
  32   contains
  33     procedure :: write_formatted => write_formatted2
  34   end type
  35 contains
  36   subroutine write_formatted1(this,unit,iotype,vlist,iostat,iomsg)
  37     class(non_abstract_child1), intent(in) :: this
  38     integer, intent(in) :: unit
  39     character (len=*), intent(in) :: iotype
  40     integer, intent(in) :: vlist(:)
  41     integer, intent(out) :: iostat
  42     character (len=*), intent(inout) :: iomsg
  43     write(unit,'(a,i2/)') "write_formatted1 => ", this%i
  44   end subroutine
  45   subroutine write_formatted2(this,unit,iotype,vlist,iostat,iomsg)
  46     class(non_abstract_child2), intent(in) :: this
  47     integer, intent(in) :: unit
  48     character (len=*), intent(in) :: iotype
  49     integer, intent(in) :: vlist(:)
  50     integer, intent(out) :: iostat
  51     character (len=*), intent(inout) :: iomsg
  52     write(unit,'(a,f4.1/)') "write_formatted2 => ", this%r
  53   end subroutine
  54   subroutine assert(a)
  55     class(object):: a
  56     write(buffer,'(DT)') a
  57   end subroutine
  58 end module
  59
  60 program p
  61   use object_interface
  62
  63   call assert (non_abstract_child1 (99))
  64   if (trim (buffer(1)) .ne. "write_formatted1 => 99") STOP 1
  65
  66   call assert (non_abstract_child2 (42.0))
  67   if (trim (buffer(1)) .ne. "write_formatted2 => 42.0") STOP 2
  68 end