procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/40870 ([F03] include formal args in backend_decl of PPCs)

Browse source 
2009-08-18  Janus Weil  <janus@gcc.gnu.org>
	    Paul Thomas  <pault@gcc.gnu.org>

	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  <janus@gcc.gnu.org>
	    Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/40870
	* gfortran.dg/proc_ptr_comp_13.f90: Extended.


Co-Authored-By: Paul Thomas <pault@gcc.gnu.org>

From-SVN: r150875
This commit is contained in:
Janus Weil 2009-08-18 16:23:35 +02:00
parent 776e717416
commit 37513ce90a
4 changed files with 36 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
gcc/fortran/ChangeLog
View file

@ -1,3 +1,12 @@
2009-08-18 Janus Weil <janus@gcc.gnu.org>
Paul Thomas <pault@gcc.gnu.org>
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 <pault@gcc.gnu.org>
PR fortran/41062

24
gcc/fortran/trans-types.c
View file

@ -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;

6
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,9 @@
2009-08-18 Janus Weil <janus@gcc.gnu.org>
Paul Thomas <pault@gcc.gnu.org>
PR fortran/40870
* gfortran.dg/proc_ptr_comp_13.f90: Extended.
2009-08-18 Richard Guenther <rguenther@suse.de>
PR middle-end/41094

12
gcc/testsuite/gfortran.dg/proc_ptr_comp_13.f90
View file

@ -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 <janus@gcc.gnu.org>
@ -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