[Patch, fortran] PR87908 - ICE in check_interface0, at fortran/interface.c:1841

[Paul Richard Thomas]

Hi All,

This one was incorrectly labelled as a PDT PR by yours truly :-) That
said, it seemed so peculiar that I investigated.

The fix is somewhat minimalist, on the assumption that resolve.cc will
pick up any problems while identifying the specific procedure. The
check that I have implemented is that there is at least one proc
pointer component that is a subroutine or function. It could have been
taken further by delving into the derived type default initializer
component to check that there is indeed a generic with the
'interface_name'. However, this is exactly what is done further
downstream.

Regtested on FC42/x86_64 - OK for mainline?

Paul

Change.Logs
Description: Binary data

diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc
index ef5a17d0af4..41c941726e2 100644
--- a/gcc/fortran/interface.cc
+++ b/gcc/fortran/interface.cc
@@ -1968,6 +1968,25 @@ check_interface0 (gfc_interface *p, const char *interface_name)
   psave = p;
   for (; p; p = p->next)
     {
+      if (p->sym->attr.vtab)
+	{
+	  bool found = false;
+	  gfc_component *c = p->sym->ts.u.derived->components;
+	  for (; c; c = c->next)
+	    {
+	      if (c->name[0] == '_')
+		continue;
+	      /* This check seems to be as much as can sensibly be done here.
+		 If there is more than one proc_pointer components, resolution
+		 of the call will select the right one.  */
+	      if (c->attr.proc_pointer && c->ts.interface
+		  && (c->attr.subroutine || c->attr.function))
+		found = true;
+	    }
+	  if (found)
+	    continue;
+	}
+
       /* Make sure all symbols in the interface have been defined as
 	 functions or subroutines.  */
       if (((!p->sym->attr.function && !p->sym->attr.subroutine)
diff --git a/gcc/testsuite/gfortran.dg/pr87908.f90 b/gcc/testsuite/gfortran.dg/pr87908.f90
new file mode 100644
index 00000000000..6fdc109a652
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr87908.f90
@@ -0,0 +1,49 @@
+! { dg-do run }
+!
+! Check the fix for pr87908, which used to fail with error:
+! Procedure ‘__vtab_m_T’ in generic interface '_dtio_formatted_read' at (1) is
+! neither function nor subroutine.
+!
+! Contributed by David Bolvansky  <david.bolvan...@gmail.com>
+!
+module m
+   type t
+      character(34) :: c
+   contains
+      procedure :: g
+      generic :: read(formatted) => g
+   end type
+   integer :: ctr = 0
+contains
+   subroutine s (unit, x)
+      integer, intent(in) :: unit
+      integer, intent(in) :: x(:)
+      interface read(formatted)
+         procedure g
+      end interface
+   end
+   subroutine g (dtv, unit, iotype, v_list, iostat, iomsg)
+      class(t), intent(inout) :: dtv
+      integer, intent(in) :: unit
+      character(*), intent(in) :: iotype
+      integer, intent(in) :: v_list(:)
+      integer, intent(out) :: iostat
+      character(*), intent(inout) :: iomsg
+      read (unit, '(a)', iostat=iostat, iomsg=iomsg) dtv%c
+      ctr = ctr + 1
+   end
+end
+
+  use m
+  type(t) :: x
+  open (10, status = 'scratch')
+  write(10, fmt=*) "Mary had a little lamb            "
+  write(10, fmt=*) "whose fleece was as white as gold "
+  rewind(10)
+  read(10, fmt=*) x
+  if (trim(x%c) /= "Mary had a little lamb") stop 1
+  read(10, fmt=*) x
+  if (trim(x%c) /= "whose fleece was as white as gold") stop 2
+  close(10)
+  if (ctr /= 2) stop 3
+end