re PR fortran/80392 ([OOP] ICE with allocatable polymorphic function result in a…

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

gcc/fortran/ChangeLog

+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

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)
 	{

gcc/testsuite/ChangeLog

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

gcc/testsuite/gfortran.dg/proc_ptr_comp_49.f90

+! { 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