From: Janus Weil <janus@gcc.gnu.org>
Date: Mon, 1 May 2017 10:51:22 +0000 (+0200)
Subject: backport: re PR fortran/80392 ([OOP] ICE with allocatable polymorphic function result... 
X-Git-Tag: releases/gcc-5.5.0~385
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=e454b682cdd67a3787f7b7817b693066684518aa;p=thirdparty%2Fgcc.git

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

2017-05-01  Janus Weil  <janus@gcc.gnu.org>

	Backport from trunk
	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-05-01  Janus Weil  <janus@gcc.gnu.org>

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

From-SVN: r247435
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index dd51c6b75048..b3f4403ba9c2 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2017-05-01  Janus Weil  <janus@gcc.gnu.org>
+
+	Backport from trunk
+	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>
 
 	Backport from trunk
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 5d59ef52f784..153914e753f3 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -2554,9 +2554,10 @@ gfc_get_derived_type (gfc_symbol * derived)
 	 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 a57d8bdd9a5c..d8c01a07dcc9 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2017-05-01  Janus Weil  <janus@gcc.gnu.org>
+
+	Backport from trunk
+	PR fortran/80392
+	* gfortran.dg/proc_ptr_comp_49.f90: New test case.
+
 2017-04-21  Janus Weil  <janus@gcc.gnu.org>
 
 	Backport from trunk
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 000000000000..e89791f728c3
--- /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