From: Paul Thomas <pault@gcc.gnu.org>
Date: Wed, 24 Sep 2025 07:01:23 +0000 (+0100)
Subject: Fortran: Fix ICE in check_interface [PR87908]
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=e77daa57300ba2cb116af8dd24f58cad00dc669c;p=thirdparty%2Fgcc.git

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 --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.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