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

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 58268d1bd3644a082b564eff539f7e3ee7b15ad5..7058511d5655ed1e550b645500763292344bce66 100644 (file)
--- 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 fc5e486379f9bf067c85f6e0dcb32e47ba792077..8617cd51a7c6f57c3ae138fe401fd5efa4ac3124 100644 (file)
--- 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 95938c4501388907844e7d94f7a0a5636d703f41..6f4dc8d50959896bec017a7ba8bffbe6d46a4c37 100644 (file)
--- 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 (file)
index 0000000..e89791f
--- /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