From c4984ab2518d2b2e971d741709111087f26ecb90 Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Tue, 28 Jul 2009 13:40:42 +0200 Subject: [PATCH] re PR fortran/40882 ([F03] infinite recursion in gfc_get_derived_type with PPC returning derived type) 2009-07-28 Janus Weil PR fortran/40882 * trans-types.c (gfc_get_ppc_type): For derived types, directly use the backend_decl, instead of calling gfc_typenode_for_spec, to avoid infinte loop. (gfc_get_derived_type): Correctly handle PPCs returning derived types, avoiding infinite recursion. 2009-07-28 Janus Weil PR fortran/40882 * gfortran.dg/proc_ptr_comp_13.f90: New. From-SVN: r150154 --- gcc/fortran/ChangeLog | 9 +++++ gcc/fortran/trans-types.c | 16 ++++++--- gcc/testsuite/ChangeLog | 5 +++ .../gfortran.dg/proc_ptr_comp_13.f90 | 35 +++++++++++++++++++ 4 files changed, 60 insertions(+), 5 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/proc_ptr_comp_13.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 7b6d59e0351d..ea622e565bfe 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2009-07-28 Janus Weil + + PR fortran/40882 + * trans-types.c (gfc_get_ppc_type): For derived types, directly use the + backend_decl, instead of calling gfc_typenode_for_spec, to avoid + infinte loop. + (gfc_get_derived_type): Correctly handle PPCs returning derived types, + avoiding infinite recursion. + 2009-07-27 Janus Weil PR fortran/40848 diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 99967ce3705f..77b8b9c66069 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -1894,7 +1894,12 @@ gfc_get_ppc_type (gfc_component* c) { tree t; if (c->attr.function && !c->attr.dimension) - t = gfc_typenode_for_spec (&c->ts); + { + if (c->ts.type == BT_DERIVED) + t = c->ts.derived->backend_decl; + else + t = gfc_typenode_for_spec (&c->ts); + } else t = void_type_node; /* TODO: Build argument list. */ @@ -1974,7 +1979,8 @@ gfc_get_derived_type (gfc_symbol * derived) if (c->ts.type != BT_DERIVED) continue; - if (!c->attr.pointer || c->ts.derived->backend_decl == NULL) + if ((!c->attr.pointer && !c->attr.proc_pointer) + || c->ts.derived->backend_decl == NULL) c->ts.derived->backend_decl = gfc_get_derived_type (c->ts.derived); if (c->ts.derived && c->ts.derived->attr.is_iso_c) @@ -2003,10 +2009,10 @@ gfc_get_derived_type (gfc_symbol * derived) fieldlist = NULL_TREE; for (c = derived->components; c; c = c->next) { - if (c->ts.type == BT_DERIVED) - field_type = c->ts.derived->backend_decl; - else if (c->attr.proc_pointer) + if (c->attr.proc_pointer) field_type = gfc_get_ppc_type (c); + else if (c->ts.type == BT_DERIVED) + field_type = c->ts.derived->backend_decl; else { if (c->ts.type == BT_CHARACTER) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 086d6f9d4818..85f780b83a7a 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2009-07-28 Janus Weil + + PR fortran/40882 + * gfortran.dg/proc_ptr_comp_13.f90: New. + 2009-07-28 Jan Beulich * gcc.target/i386/avx-vtestpd-1.c: Add -DNEED_IEEE754_DOUBLE. diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_13.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_13.f90 new file mode 100644 index 000000000000..45ffa1e12740 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_13.f90 @@ -0,0 +1,35 @@ +! { dg-do run } +! +! PR 40882: [F03] infinite recursion in gfc_get_derived_type with PPC returning derived type +! +! Contributed by Janus Weil + +implicit none + +type :: t + integer :: data + procedure(foo), pointer, nopass :: ppc +end type + +type(t) :: o,o2 + +o%data = 1 +o%ppc => foo + +o2 = o%ppc() + +if (o%data /= 1) call abort() +if (o2%data /= 5) call abort() +if (.not. associated(o%ppc)) call abort() +if (associated(o2%ppc)) call abort() + +contains + + function foo() + type(t) :: foo + foo%data = 5 + foo%ppc => NULL() + end function + +end + -- 2.43.5