OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/40882 ([F03] infinite recursion in gfc_get_derived_type with PPC returning derived type)

Browse Source 
2009-07-28  Janus Weil  <janus@gcc.gnu.org>

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

	PR fortran/40882
	* gfortran.dg/proc_ptr_comp_13.f90: New.

From-SVN: r150154
This commit is contained in:
Janus Weil 2009-07-28 13:40:42 +02:00
parent fe8b685c3e
commit c4984ab251
4 changed files with 60 additions and 5 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-07-28 Janus Weil <janus@gcc.gnu.org>
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 <janus@gcc.gnu.org>
PR fortran/40848

16
gcc/fortran/trans-types.c
View File

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

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2009-07-28 Janus Weil <janus@gcc.gnu.org>
PR fortran/40882
* gfortran.dg/proc_ptr_comp_13.f90: New.
2009-07-28 Jan Beulich <jbeulich@novell.com>
* gcc.target/i386/avx-vtestpd-1.c: Add -DNEED_IEEE754_DOUBLE.

35
gcc/testsuite/gfortran.dg/proc_ptr_comp_13.f90 Normal file
View File

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