re PR fortran/77657 (link error with implementation of user-defined derived type…

re PR fortran/77657 (link error with implementation of user-defined derived type input/output (UD-DTIO) in child extending abstract parent)

2016-09-21  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/77657

	* interface.c (gfc_find_specific_dtio_proc): Borrow trick from
	resolve_typebound_generic_call to find dtio procedures that
	over-ride those in the declared type.

2016-09-21  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/77657
	* gfortran.dg/dtio_12.f90: New test.

From-SVN: r240301

gcc/fortran/ChangeLog

+2016-09-21  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/77657
+
+	* interface.c (gfc_find_specific_dtio_proc): Borrow trick from
+	resolve_typebound_generic_call to find dtio procedures that
+	over-ride those in the declared type.
+
 2016-09-20  Marek Polacek  <polacek@redhat.com>
 
 	* trans-intrinsic.c (conv_expr_ref_to_caf_ref): Adjust fall through
@@ -96,7 +104,7 @@
 2016-09-16  Steven G. Kargl  <kargl@gcc.gnu.org>
 
 	PR fortran/77612
-	* decl.c (char_len_param_value): Check parent namespace for 
+	* decl.c (char_len_param_value): Check parent namespace for
 	seen_implicit_none.
 
 2016-09-15  Louis Krupp  <louis.krupp@zoho.com>
@@ -144,7 +152,7 @@
 
 	PR fortran/69514
 	* array.c (gfc_match_array_constructor):  If type-spec is present,
-	walk the array constructor performing possible conversions for 
+	walk the array constructor performing possible conversions for
 	numeric types.
 
 2016-09-08  Jakub Jelinek  <jakub@redhat.com>
@@ -159,7 +167,7 @@
 	PR fortran/77391
 	* resolve.c (deferred_requirements): New function to check F2008:C402.
 	(resolve_fl_variable,resolve_fl_parameter): Use it.
- 
+
 2016-09-04  Steven G. Kargl  <kargl@gcc.gnu.org>
 
 	PR fortran/77460

gcc/fortran/interface.c

@@ -4792,6 +4792,9 @@ gfc_find_specific_dtio_proc (gfc_symbol *derived, bool write, bool formatted)
 
   if (tb_io_st != NULL)
     {
+      const char *genname;
+      gfc_symtree *st;
+
       tb_io_proc = tb_io_st->n.tb;
       gcc_assert (tb_io_proc != NULL);
       gcc_assert (tb_io_proc->is_generic);
@@ -4800,7 +4803,16 @@ gfc_find_specific_dtio_proc (gfc_symbol *derived, bool write, bool formatted)
       specific_proc = tb_io_proc->u.generic->specific;
       gcc_assert (!specific_proc->is_generic);
 
-      dtio_sub = specific_proc->u.specific->n.sym;
+      /* Go back and make sure that we have the right specific procedure.
+	 Here we most likely have a procedure from the parent type, which
+	 can be overridden in extensions.  */
+      genname = tb_io_proc->u.generic->specific_st->name;
+      st = gfc_find_typebound_proc (derived, NULL, genname,
+				    true, &tb_io_proc->where);
+      if (st)
+	dtio_sub = st->n.tb->u.specific->n.sym;
+      else
+	dtio_sub = specific_proc->u.specific->n.sym;
     }
 
   if (tb_io_st != NULL)

gcc/testsuite/ChangeLog

+2016-09-21  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/77657
+	* gfortran.dg/dtio_12.f90: New test.
+
 2016-09-21  Senthil Kumar Selvaraj  <senthil_kumar.selvaraj@atmel.com>
 
 	* gcc.dg/tree-ssa/pr64130.c: Use __UINT32_TYPE__ instead of int.

gcc/testsuite/gfortran.dg/dtio_12.f90

+! { dg-do run }
+!
+! Test the fix for PR77657 in which the DTIO subroutine was not found,
+! which led to an error in attempting to link to the abstract interface.
+!
+! Contributed by Damian Rouson  <damian@sourceryinstitute.org>
+!
+MODULE abstract_parent
+  implicit none
+
+  type, abstract :: parent
+  contains
+    procedure(write_formatted_interface), deferred :: write_formatted
+    generic :: write(formatted) => write_formatted
+  end type parent
+
+  abstract interface
+    subroutine write_formatted_interface(this,unit,iotype,vlist,iostat,iomsg)
+      import parent
+      class(parent), 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
+    end subroutine
+  end interface
+
+end module
+
+module child_module
+  use abstract_parent, only : parent
+  implicit none
+
+  type, extends(parent) :: child
+    integer :: i = 99
+  contains
+    procedure :: write_formatted
+  end type
+contains
+  subroutine write_formatted(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
+    write (unit, "(i4)") this%i
+  end subroutine
+end module
+
+  use child_module, only : child
+  implicit none
+  type (child) :: baby
+  integer :: v(1), istat
+  character(20) :: msg
+  open (10, status = "scratch")
+  call baby%write_formatted(10, "abcd", v, istat, msg) ! Call the dtio proc directly
+  rewind (10)
+  read (10, *) msg
+  if (trim (msg) .ne. "99") call abort
+  rewind (10)
+  baby%i = 42
+  write (10,"(DT)") baby                               ! Call the dtio proc via the library
+  rewind (10)
+  read (10, *) msg
+  if (trim (msg) .ne. "42") call abort
+  rewind (10)
+  write (10,"(DT)") child (77)                         ! The original testcase
+  rewind (10)
+  read (10, *) msg
+  if (trim (msg) .ne. "77") call abort
+  close(10)
+end