From fc23d35a75c0d2fe93f62434708b74e98779625d Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Fri, 21 Apr 2017 22:47:12 +0200 Subject: [PATCH] re PR fortran/80392 ([OOP] ICE with allocatable polymorphic function result in a procedure pointer component) 2017-04-21 Janus Weil 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 PR fortran/80392 * gfortran.dg/proc_ptr_comp_49.f90: New test case. From-SVN: r247069 --- gcc/fortran/ChangeLog | 7 +++++++ gcc/fortran/trans-types.c | 7 ++++--- gcc/testsuite/ChangeLog | 5 +++++ .../gfortran.dg/proc_ptr_comp_49.f90 | 21 +++++++++++++++++++ 4 files changed, 37 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/proc_ptr_comp_49.f90 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 + + 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 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 + + PR fortran/80392 + * gfortran.dg/proc_ptr_comp_49.f90: New test case. + 2017-04-21 Uros Bizjak * 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 + +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 -- 2.30.2