From 380bfbbd61795428e53826d379ce1f4bfe1768f0 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sun, 10 Sep 2006 17:17:57 +0000 Subject: [PATCH] re PR fortran/28959 (ICE on derived type with host association) 2006-09-10 Paul Thomas PR fortran/28959 trans-types.c (gfc_get_derived_type): Use the parent namespace of the procedure if the type's own namespace does not have a parent. 2006-09-10 Paul Thomas PR fortran/28959 gfortran.dg/used_types_10: New test. From-SVN: r116816 --- gcc/fortran/ChangeLog | 6 ++ gcc/fortran/trans-types.c | 7 +- gcc/testsuite/ChangeLog | 7 +- gcc/testsuite/gfortran.dg/used_types_10.f90 | 72 +++++++++++++++++++++ 4 files changed, 90 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/used_types_10.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 5b622157398..159b4d13a49 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2006-09-10 Paul Thomas + + PR fortran/28959 + trans-types.c (gfc_get_derived_type): Use the parent namespace of + the procedure if the type's own namespace does not have a parent. + 2006-09-10 Paul Thomas PR fortran/28923 diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 4ecf94b4c9f..377a5af9fa0 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -1483,7 +1483,12 @@ gfc_get_derived_type (gfc_symbol * derived) same TREE_TYPE. If an equal type is found without a backend_decl, build the parent version and use it in the current namespace. */ - for (ns = derived->ns->parent; ns; ns = ns->parent) + /* Derived types in an interface body obtain their parent reference + through the proc_name symbol. */ + ns = derived->ns->parent ? derived->ns->parent + : derived->ns->proc_name->ns->parent; + + for (; ns; ns = ns->parent) { for (dt = ns->derived_types; dt; dt = dt->next) { diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 152d5cf911e..c482122901d 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,4 +1,9 @@ -2006-09-09 Paul Thomas +2006-09-10 Paul Thomas + + PR fortran/28959 + gfortran.dg/used_types_10: New test. + +2006-09-10 Paul Thomas PR libfortran/28923 gfortran.dg/array_initializer_2.f90: Fill in missing index start value. diff --git a/gcc/testsuite/gfortran.dg/used_types_10.f90 b/gcc/testsuite/gfortran.dg/used_types_10.f90 new file mode 100644 index 00000000000..c35fb58e617 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/used_types_10.f90 @@ -0,0 +1,72 @@ +! { dg-do compile } +! Tests the fix for PR28959 in which interface derived types were +! not always being associated. +! +! Contributed by Salvatore Filippone +! +module derived_type_mod + + type foo_dtype + integer, pointer :: v1(:)=>null() + end type foo_dtype + + +end module derived_type_mod + + +Module tools + + interface foo_d_sub + subroutine cdalv(m, v, i, desc_a, info, flag) + use derived_type_mod + Integer, intent(in) :: m,i, v(:) + integer, intent(in), optional :: flag + integer, intent(out) :: info + Type(foo_dtype), intent(out) :: desc_a + end subroutine cdalv + end interface + +end module tools + + + +subroutine foo_bar(a,p,info) + use derived_type_mod + implicit none + + type(foo_dtype), intent(in) :: a + type(foo_dtype), intent(inout) :: p + integer, intent(out) :: info + + info=0 + + call inner_sub(info) + + + return + + +contains + + subroutine inner_sub(info) + use tools + implicit none + + integer, intent(out) :: info + + integer :: i, nt,iv(10) + + i = 0 + nt = 1 + + call foo_d_sub(nt,iv,i,p,info,flag=1) + + return + + + end subroutine inner_sub + + + +end subroutine foo_bar +! { dg-final { cleanup-modules "derived_type_mod tools" } }