From: Janus Weil <janus@gcc.gnu.org>
Date: Sun, 18 Dec 2016 11:03:41 +0000 (+0100)
Subject: re PR fortran/78592 (ICE in gfc_find_specific_dtio_proc, at fortran/interface.c:4939)
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=413e859cdf69f402e64da550f6513021eb173fdc;p=gcc.git

re PR fortran/78592 (ICE in gfc_find_specific_dtio_proc, at fortran/interface.c:4939)

2016-12-18  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/78592
	* interfac.c (gfc_find_specific_dtio_proc): Fixup for r243005, making
	sure that the generic list is followed through until the end.

2016-12-18  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/78592
	* gfortran.dg/dtio_21.f90: New test.

From-SVN: r243783
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 7bb3bbc87da..693d51fd5ba 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,9 +1,13 @@
+2016-12-18  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/78592
+	* interfac.c (gfc_find_specific_dtio_proc): Fixup for r243005, making
+	sure that the generic list is followed through until the end.
+
 2016-12-17  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	PR fortran/78239
-	* decl.c (char_len_param_value):  Actually commit
-	previous change.
-
+	* decl.c (char_len_param_value): Actually commit previous change.
 
 2016-12-17  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 6e61aec1d01..6264aba3916 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -4949,17 +4949,19 @@ gfc_find_specific_dtio_proc (gfc_symbol *derived, bool write, bool formatted)
 	  && tb_io_st->n.sym->generic)
 	{
 	  for (gfc_interface *intr = tb_io_st->n.sym->generic;
-	       intr && intr->sym && intr->sym->formal;
-	       intr = intr->next)
+	       intr && intr->sym; intr = intr->next)
 	    {
-	      gfc_symbol *fsym = intr->sym->formal->sym;
-	      if ((fsym->ts.type == BT_CLASS
-		   && CLASS_DATA (fsym)->ts.u.derived == extended)
-		  || (fsym->ts.type == BT_DERIVED
-		      && fsym->ts.u.derived == extended))
+	      if (intr->sym->formal)
 		{
-		  dtio_sub = intr->sym;
-		  break;
+		  gfc_symbol *fsym = intr->sym->formal->sym;
+		  if ((fsym->ts.type == BT_CLASS
+		      && CLASS_DATA (fsym)->ts.u.derived == extended)
+		      || (fsym->ts.type == BT_DERIVED
+			  && fsym->ts.u.derived == extended))
+		    {
+		      dtio_sub = intr->sym;
+		      break;
+		    }
 		}
 	    }
 	}
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index c7bf548ed3c..6583316bbf4 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2016-12-18  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/78592
+	* gfortran.dg/dtio_21.f90: New test.
+
 2016-12-17  Steven G. Kargl  <kargl@gcc.gnu.org>
 
 	PR fortran/78746
diff --git a/gcc/testsuite/gfortran.dg/dtio_21.f90 b/gcc/testsuite/gfortran.dg/dtio_21.f90
new file mode 100644
index 00000000000..8bfe3aa4367
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dtio_21.f90
@@ -0,0 +1,30 @@
+! { dg-do compile }
+!
+! PR 78592: [7 Regression] ICE in gfc_find_specific_dtio_proc, at fortran/interface.c:4939
+!
+! Contributed by Mikael Morin <morin-mikael@orange.fr>
+
+program p
+   type t
+   end type
+   type(t) :: z
+   type, extends(t) :: t2
+   end type
+   class(t2), allocatable :: z2
+   interface write(formatted)
+      procedure wf2
+      module procedure wf   ! { dg-error "is neither function nor subroutine" }
+   end interface
+   print *, z
+   allocate(z2)
+   print *, z2
+  contains
+   subroutine wf2(this, a, b, c, d, e)
+      class(t2), intent(in) :: this
+      integer, intent(in) :: a
+      character, intent(in) :: b
+      integer, intent(in) :: c(:)
+      integer, intent(out) :: d
+      character, intent(inout) :: e
+   end subroutine wf2
+end