From 9d5c21c1f0bc3888f494dc9114e27570646c0a8f Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Tue, 17 Jun 2008 18:08:24 +0000 Subject: [PATCH] re PR fortran/34396 (Length of substrings defined by expressions not correctly computed in constructors) 2008-06-17 Paul Thomas PR fortran/34396 * resolve.c (add_dt_to_dt_list): New function. (resolve_fl_derived): Call new function for pointer components and when derived type resolved. 2008-06-17 Paul Thomas PR fortran/36366 * gfortran.dg/used_types_20.f90: New test. From-SVN: r136871 --- gcc/fortran/ChangeLog | 7 +++ gcc/fortran/resolve.c | 44 +++++++++++++----- gcc/testsuite/ChangeLog | 5 +++ gcc/testsuite/gfortran.dg/used_types_20.f90 | 49 +++++++++++++++++++++ 4 files changed, 93 insertions(+), 12 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/used_types_20.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 307af676b8a..1bf3c931734 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2008-06-17 Paul Thomas + + PR fortran/34396 + * resolve.c (add_dt_to_dt_list): New function. + (resolve_fl_derived): Call new function for pointer components + and when derived type resolved. + 2008-06-15 Jerry DeLisle PR fortran/36515 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 9c0e45d63c6..37bafd091b7 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -7586,13 +7586,33 @@ error: } +/* Add a derived type to the dt_list. The dt_list is used in trans-types.c + to give all identical derived types the same backend_decl. */ +static void +add_dt_to_dt_list (gfc_symbol *derived) +{ + gfc_dt_list *dt_list; + + for (dt_list = gfc_derived_types; dt_list; dt_list = dt_list->next) + if (derived == dt_list->derived) + break; + + if (dt_list == NULL) + { + dt_list = gfc_get_dt_list (); + dt_list->next = gfc_derived_types; + dt_list->derived = derived; + gfc_derived_types = dt_list; + } +} + + /* Resolve the components of a derived type. */ static try resolve_fl_derived (gfc_symbol *sym) { gfc_component *c; - gfc_dt_list * dt_list; int i; for (c = sym->components; c != NULL; c = c->next) @@ -7644,6 +7664,16 @@ resolve_fl_derived (gfc_symbol *sym) return FAILURE; } + /* Ensure that all the derived type components are put on the + derived type list; even in formal namespaces, where derived type + pointer components might not have been declared. */ + if (c->ts.type == BT_DERIVED + && c->ts.derived + && c->ts.derived->components + && c->pointer + && sym != c->ts.derived) + add_dt_to_dt_list (c->ts.derived); + if (c->pointer || c->allocatable || c->as == NULL) continue; @@ -7669,17 +7699,7 @@ resolve_fl_derived (gfc_symbol *sym) return FAILURE; /* Add derived type to the derived type list. */ - for (dt_list = gfc_derived_types; dt_list; dt_list = dt_list->next) - if (sym == dt_list->derived) - break; - - if (dt_list == NULL) - { - dt_list = gfc_get_dt_list (); - dt_list->next = gfc_derived_types; - dt_list->derived = sym; - gfc_derived_types = dt_list; - } + add_dt_to_dt_list (sym); return SUCCESS; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 4aec420c521..4f29172dfce 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2008-06-17 Paul Thomas + + PR fortran/36366 + * gfortran.dg/used_types_20.f90: New test. + 2008-06-16 Jerry DeLisle PR fortran/36546 diff --git a/gcc/testsuite/gfortran.dg/used_types_20.f90 b/gcc/testsuite/gfortran.dg/used_types_20.f90 new file mode 100644 index 00000000000..c08235c67f2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/used_types_20.f90 @@ -0,0 +1,49 @@ +! { dg-do compile } +! Tests the fix for PR36366 a regression in which the order of USE statements +! in 'test2' would cause the result of 'test1' not to have a reference to +! the derived type 'inner'. +! +! Contributed by Jakub Jelinek +! +MODULE types + IMPLICIT NONE + TYPE :: inner + INTEGER, POINTER :: i(:) + END TYPE inner + + TYPE :: outer + TYPE(inner), POINTER :: inr(:) + END TYPE outer +END MODULE types + +MODULE mymod + IMPLICIT NONE +CONTAINS + FUNCTION test1() + USE types + IMPLICIT NONE + TYPE(outer), POINTER :: test1 + NULLIFY(test1) + END FUNCTION test1 +END MODULE mymod + +MODULE test + IMPLICIT NONE +CONTAINS + + SUBROUTINE test2(a) + USE mymod + USE types + IMPLICIT NONE + TYPE(outer), INTENT(INOUT) :: a + INTEGER :: i + i = a%inr(1)%i(1) + END SUBROUTINE test2 + + SUBROUTINE test3(a) + USE types + IMPLICIT NONE + TYPE(outer), INTENT(IN) :: a + END SUBROUTINE test3 +END MODULE test +! { dg-final { cleanup-modules "types mymod test" } } -- 2.30.2