From: Janus Weil <janus@gcc.gnu.org>
Date: Fri, 21 Apr 2017 20:47:12 +0000 (+0200)
Subject: re PR fortran/80392 ([OOP] ICE with allocatable polymorphic function result in a... 
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=fc23d35a75c0d2fe93f62434708b74e98779625d;p=gcc.git

re PR fortran/80392 ([OOP] ICE with allocatable polymorphic function result in a procedure pointer component)

2017-04-21  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/80392
	* trans-types.c (gfc_get_derived_type): Prevent an infinite loop when
	building a derived type that includes a procedure pointer component
	with a polymorphic result.

2017-04-21  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/80392
	* gfortran.dg/proc_ptr_comp_49.f90: New test case.

From-SVN: r247069
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 58268d1bd36..7058511d565 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2017-04-21  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/80392
+	* trans-types.c (gfc_get_derived_type): Prevent an infinite loop when
+	building a derived type that includes a procedure pointer component
+	with a polymorphic result.
+
 2017-04-17  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/80440
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index fc5e486379f..8617cd51a7c 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -2617,9 +2617,10 @@ gfc_get_derived_type (gfc_symbol * derived, int codimen)
 	 the same as derived, by forcing the procedure pointer component to
 	 be built as if the explicit interface does not exist.  */
       if (c->attr.proc_pointer
-	  && ((c->ts.type != BT_DERIVED && c->ts.type != BT_CLASS)
-	       || (c->ts.u.derived
-		   && !gfc_compare_derived_types (derived, c->ts.u.derived))))
+	  && (c->ts.type != BT_DERIVED || (c->ts.u.derived
+		    && !gfc_compare_derived_types (derived, c->ts.u.derived)))
+	  && (c->ts.type != BT_CLASS || (CLASS_DATA (c)->ts.u.derived
+		    && !gfc_compare_derived_types (derived, CLASS_DATA (c)->ts.u.derived))))
 	field_type = gfc_get_ppc_type (c);
       else if (c->attr.proc_pointer && derived->backend_decl)
 	{
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 95938c45013..6f4dc8d5095 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2017-04-21  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/80392
+	* gfortran.dg/proc_ptr_comp_49.f90: New test case.
+
 2017-04-21  Uros Bizjak  <ubizjak@gmail.com>
 
 	* gcc.target/i386/pr79804.c: Add additional dg-error directive.
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_49.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_49.f90
new file mode 100644
index 00000000000..e89791f728c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_49.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+!
+! PR 80392: [5/6/7 Regression] [OOP] ICE with allocatable polymorphic function result in a procedure pointer component
+!
+! Contributed by <zed.three@gmail.com>
+
+module mwe
+
+  implicit none
+
+  type :: MyType
+     procedure(my_op), nopass, pointer :: op
+  end type
+
+contains
+
+  function my_op() result(foo)
+    class(MyType), allocatable :: foo
+  end function
+
+end module