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

[Paul Thomas via Gcc-cvs]

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

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

    Fortran: Fix ICE in check_interface [PR87908]
    
    2025-09-24  Paul Thomas  <pa...@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.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