[gcc r16-4069] Fortran: Fix ICE in check_interface [PR87908]

[Paul Thomas]

https://gcc.gnu.org/g:e77daa57300ba2cb116af8dd24f58cad00dc669c

commit r16-4069-ge77daa57300ba2cb116af8dd24f58cad00dc669c
Author: Paul Thomas <pault@gcc.gnu.org>
Date:   Wed Sep 24 08:01:23 2025 +0100

    Fortran: Fix ICE in check_interface [PR87908]
    
    2025-09-24  Paul Thomas  <pault@gcc.gnu.org>
    
    gcc/fortran
            PR fortran/87908
            * interface.cc (check_interface0): If a vtable is found in the
            interface list, check that it is either a subroutine or a
            function. Let resolve.cc do any further checking.
    
    gcc/testsuite/
            PR fortran/87908
            * gfortran.dg/pr87908.f90: New test.

Diff:
---
 gcc/fortran/interface.cc              | 19 ++++++++++++++
 gcc/testsuite/gfortran.dg/pr87908.f90 | 49 +++++++++++++++++++++++++++++++++++
 2 files changed, 68 insertions(+)

diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc
index ef5a17d0af45..41c941726e22 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 000000000000..6fdc109a6522
--- /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.bolvansky@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