From: janus Date: Tue, 18 Aug 2009 14:23:35 +0000 (+0000) Subject: 2009-08-18 Janus Weil X-Git-Url: http://git.sourceforge.jp/view?p=pf3gnuchains%2Fgcc-fork.git;a=commitdiff_plain;h=b75755d741603b06742e27c255a52eaf85be61a3 2009-08-18 Janus Weil Paul Thomas PR fortran/40870 * trans-types.c (gfc_get_ppc_type): Include formal args in backend_decl using the interface symbol. Character types are returned by reference. (gfc_get_derived_type): Prevent infinite recursion loop if a PPC has a derived-type formal arg. 2009-08-18 Janus Weil Paul Thomas PR fortran/40870 * gfortran.dg/proc_ptr_comp_13.f90: Extended. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@150875 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index cf5b4ece304..d7873260933 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2009-08-18 Janus Weil + Paul Thomas + + PR fortran/40870 + * trans-types.c (gfc_get_ppc_type): Include formal args in backend_decl + using the interface symbol. Character types are returned by reference. + (gfc_get_derived_type): Prevent infinite recursion loop + if a PPC has a derived-type formal arg. + 2008-08-17 Paul Thomas PR fortran/41062 diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 8cc63c26037..90e82d488d7 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -1895,16 +1895,17 @@ tree gfc_get_ppc_type (gfc_component* c) { tree t; - if (c->attr.function && !c->attr.dimension) - { - if (c->ts.type == BT_DERIVED) - t = c->ts.u.derived->backend_decl; - else - t = gfc_typenode_for_spec (&c->ts); - } + + /* Explicit interface. */ + if (c->attr.if_source != IFSRC_UNKNOWN && c->ts.interface) + return build_pointer_type (gfc_get_function_type (c->ts.interface)); + + /* Implicit interface (only return value may be known). */ + if (c->attr.function && !c->attr.dimension && c->ts.type != BT_CHARACTER) + t = gfc_typenode_for_spec (&c->ts); else t = void_type_node; - /* TODO: Build argument list. */ + return build_pointer_type (build_function_type (t, NULL_TREE)); } @@ -2012,8 +2013,11 @@ gfc_get_derived_type (gfc_symbol * derived) components' backend_decl may have not been built. */ if (derived->backend_decl) { - /* Its components' backend_decl have been built. */ - if (TYPE_FIELDS (derived->backend_decl)) + /* Its components' backend_decl have been built or we are + seeing recursion through the formal arglist of a procedure + pointer component. */ + if (TYPE_FIELDS (derived->backend_decl) + || derived->attr.proc_pointer_comp) return derived->backend_decl; else typenode = derived->backend_decl; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 464e14c2773..c0d49236d95 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2009-08-18 Janus Weil + Paul Thomas + + PR fortran/40870 + * gfortran.dg/proc_ptr_comp_13.f90: Extended. + 2009-08-18 Richard Guenther PR middle-end/41094 diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_13.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_13.f90 index 45ffa1e1274..afc8f55b5d3 100644 --- a/gcc/testsuite/gfortran.dg/proc_ptr_comp_13.f90 +++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_13.f90 @@ -1,6 +1,7 @@ ! { dg-do run } ! -! PR 40882: [F03] infinite recursion in gfc_get_derived_type with PPC returning derived type +! PR 40882: [F03] infinite recursion in gfc_get_derived_type with PPC returning derived type. +! At the same time, check that a formal argument does not cause infinite recursion (PR 40870). ! ! Contributed by Janus Weil @@ -9,6 +10,7 @@ implicit none type :: t integer :: data procedure(foo), pointer, nopass :: ppc + procedure(type(t)), pointer, nopass :: ppc2 end type type(t) :: o,o2 @@ -16,7 +18,7 @@ type(t) :: o,o2 o%data = 1 o%ppc => foo -o2 = o%ppc() +o2 = o%ppc(o) if (o%data /= 1) call abort() if (o2%data /= 5) call abort() @@ -25,9 +27,9 @@ if (associated(o2%ppc)) call abort() contains - function foo() - type(t) :: foo - foo%data = 5 + function foo(arg) + type(t) :: foo, arg + foo%data = arg%data * 5 foo%ppc => NULL() end function