From 7453378e3d16d7b048668ec46ab93f7bb9043308 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sun, 18 Mar 2007 15:00:55 +0000 Subject: [PATCH] re PR fortran/30531 ([4.2 only] allocatable component and intent(out) yield ICE in fold_convert) 2007-03-18 Paul Thomas PR fortran/30531 PR fortran/31086 * symbo.c : Add gfc_derived_types. (gfc_free_dt_list): Free derived type list gfc_derived_types. (gfc_free_namespace): Remove call to gfc_free_dt_list. (gfc_symbol_done_2): Call gfc_free_dt_list. * gfortran.h : Declare gfc_derived_types to be external. Remove derived types field from gfc_namespace. * resolve.c (resolve_fl_derived): Refer to gfc_derived types rather than namespace derived_types. (resolve_fntype): Remove special treatment for module derived type functions. * trans-types.c (gfc_get_derived_type): Remove search for like derived types. Finish by copying back end declaration to like derived types in the derived type list gfc_derived_types. 2007-03-18 Paul Thomas PR fortran/30531 * gfortran.dg/used_types_14.f90: New test. PR fortran/31086 * gfortran.dg/used_types_15.f90: New test. From-SVN: r123037 --- gcc/fortran/ChangeLog | 20 +++++++++++++- gcc/fortran/gfortran.h | 5 ++-- gcc/fortran/resolve.c | 23 +++------------- gcc/fortran/symbol.c | 15 ++++++----- gcc/fortran/trans-types.c | 42 ++--------------------------- gcc/testsuite/ChangeLog | 8 ++++++ gcc/testsuite/gfortran.dg/used_types_14.f90 | 32 ++++++++++++++++++++++ gcc/testsuite/gfortran.dg/used_types_15.f90 | 35 ++++++++++++++++++++++++ 8 files changed, 111 insertions(+), 69 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/used_types_14.f90 create mode 100644 gcc/testsuite/gfortran.dg/used_types_15.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 7630539..9ba6544 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,4 +1,22 @@ -2007-03-17 Francois-Xavier Coudert +2007-03-18 Paul Thomas + + PR fortran/30531 + PR fortran/31086 + * symbo.c : Add gfc_derived_types. + (gfc_free_dt_list): Free derived type list gfc_derived_types. + (gfc_free_namespace): Remove call to gfc_free_dt_list. + (gfc_symbol_done_2): Call gfc_free_dt_list. + * gfortran.h : Declare gfc_derived_types to be external. Remove + derived types field from gfc_namespace. + * resolve.c (resolve_fl_derived): Refer to gfc_derived types + rather than namespace derived_types. + (resolve_fntype): Remove special treatment for module + derived type functions. + * trans-types.c (gfc_get_derived_type): Remove search for like + derived types. Finish by copying back end declaration to like + derived types in the derived type list gfc_derived_types. + + 2007-03-17 Francois-Xavier Coudert PR fortran/31120 * trans-expr.c (gfc_conv_powi): Make n argument unsigned hwi. diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index b806f18..6da8a93 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -950,6 +950,8 @@ gfc_dt_list; #define gfc_get_dt_list() gfc_getmem(sizeof(gfc_dt_list)) + /* A list of all derived types. */ + extern gfc_dt_list *gfc_derived_types; /* A namespace describes the contents of procedure, module or interface block. */ @@ -1013,9 +1015,6 @@ typedef struct gfc_namespace /* A list of all alternate entry points to this procedure (or NULL). */ gfc_entry_list *entries; - /* A list of all derived types in this procedure (or NULL). */ - gfc_dt_list *derived_types; - /* Set to 1 if namespace is a BLOCK DATA program unit. */ int is_block_data; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index db55c0c..a72047e 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -5932,16 +5932,16 @@ resolve_fl_derived (gfc_symbol *sym) } /* Add derived type to the derived type list. */ - for (dt_list = sym->ns->derived_types; dt_list; dt_list = dt_list->next) + 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 = sym->ns->derived_types; + dt_list->next = gfc_derived_types; dt_list->derived = sym; - sym->ns->derived_types = dt_list; + gfc_derived_types = dt_list; } return SUCCESS; @@ -7154,22 +7154,7 @@ resolve_fntype (gfc_namespace *ns) sym->name, &sym->declared_at, sym->ts.derived->name); } - /* Make sure that the type of a module derived type function is in the - module namespace, by copying it from the namespace's derived type - list, if necessary. */ - if (sym->ts.type == BT_DERIVED - && sym->ns->proc_name->attr.flavor == FL_MODULE - && sym->ts.derived->ns - && sym->ns != sym->ts.derived->ns) - { - gfc_dt_list *dt = sym->ns->derived_types; - - for (; dt; dt = dt->next) - if (gfc_compare_derived_types (sym->ts.derived, dt->derived)) - sym->ts.derived = dt->derived; - } - - if (ns->entries) + if (ns->entries) for (el = ns->entries->next; el; el = el->next) { if (el->sym->result == el->sym diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 8f2ab83..7bf9aec 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -91,6 +91,8 @@ gfc_gsymbol *gfc_gsym_root = NULL; static gfc_symbol *changed_syms = NULL; +gfc_dt_list *gfc_derived_types; + /*********** IMPLICIT NONE and IMPLICIT statement handlers ***********/ @@ -2528,18 +2530,20 @@ free_sym_tree (gfc_symtree * sym_tree) } -/* Free a derived type list. */ +/* Free the derived type list. */ static void -gfc_free_dt_list (gfc_dt_list * dt) +gfc_free_dt_list (void) { - gfc_dt_list *n; + gfc_dt_list *dt, *n; - for (; dt; dt = n) + for (dt = gfc_derived_types; dt; dt = n) { n = dt->next; gfc_free (dt); } + + gfc_derived_types = NULL; } @@ -2605,8 +2609,6 @@ gfc_free_namespace (gfc_namespace * ns) gfc_free_equiv (ns->equiv); gfc_free_equiv_lists (ns->equiv_lists); - gfc_free_dt_list (ns->derived_types); - for (i = GFC_INTRINSIC_BEGIN; i != GFC_INTRINSIC_END; i++) gfc_free_interface (ns->operator[i]); @@ -2639,6 +2641,7 @@ gfc_symbol_done_2 (void) gfc_free_namespace (gfc_current_ns); gfc_current_ns = NULL; + gfc_free_dt_list (); } diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 1612189..db93a10 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -1463,7 +1463,6 @@ gfc_get_derived_type (gfc_symbol * derived) tree typenode, field, field_type, fieldlist; gfc_component *c; gfc_dt_list *dt; - gfc_namespace * ns; gcc_assert (derived && derived->attr.flavor == FL_DERIVED); @@ -1479,39 +1478,6 @@ gfc_get_derived_type (gfc_symbol * derived) } else { - /* If an equal derived type is already available in the parent namespace, - use its backend declaration and those of its components, rather than - building anew so that potential dummy and actual arguments use the - same TREE_TYPE. If an equal type is found without a backend_decl, - build the parent version and use it in the current namespace. */ - if (derived->ns->parent) - ns = derived->ns->parent; - else if (derived->ns->proc_name - && derived->ns->proc_name->ns != derived->ns) - /* Derived types in an interface body obtain their parent reference - through the proc_name symbol. */ - ns = derived->ns->proc_name->ns; - else - /* Sometimes there isn't a parent reference! */ - ns = NULL; - - for (; ns; ns = ns->parent) - { - for (dt = ns->derived_types; dt; dt = dt->next) - { - if (dt->derived == derived) - continue; - - if (dt->derived->backend_decl == NULL - && gfc_compare_derived_types (dt->derived, derived)) - gfc_get_derived_type (dt->derived); - - if (copy_dt_decls_ifequal (dt->derived, derived)) - break; - } - if (derived->backend_decl) - goto other_equal_dts; - } /* We see this derived type first time, so build the type node. */ typenode = make_node (RECORD_TYPE); @@ -1591,12 +1557,8 @@ gfc_get_derived_type (gfc_symbol * derived) derived->backend_decl = typenode; -other_equal_dts: - /* Add this backend_decl to all the other, equal derived types and - their components in this and sibling namespaces. */ - ns = derived->ns->parent ? derived->ns->parent->contained : derived->ns; - for (; ns; ns = ns->sibling) - for (dt = ns->derived_types; dt; dt = dt->next) + /* Add this backend_decl to all the other, equal derived types. */ + for (dt = gfc_derived_types; dt; dt = dt->next) copy_dt_decls_ifequal (derived, dt->derived); return derived->backend_decl; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 2a61218..51540e3 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2007-03-18 Paul Thomas + + PR fortran/30531 + * gfortran.dg/used_types_14.f90: New test. + + PR fortran/31086 + * gfortran.dg/used_types_15.f90: New test. + 2007-03-18 Dorit Nuzman * gcc.dg/vect/no-tree-dom-vect-bug.c: New test. diff --git a/gcc/testsuite/gfortran.dg/used_types_14.f90 b/gcc/testsuite/gfortran.dg/used_types_14.f90 new file mode 100644 index 0000000..3316b4a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/used_types_14.f90 @@ -0,0 +1,32 @@ +! { dg-do compile } +! Tests the fix for PR30531 in which the interface derived types +! was not being associated. +! +! Contributed by Salvatore Filippone +! +module foo_type_mod + type foo_type + integer, allocatable :: md(:) + end type foo_type +end module foo_type_mod + +module foo_mod + + interface + subroutine foo_initvg(foo_a) + use foo_type_mod + Type(foo_type), intent(out) :: foo_a + end subroutine foo_initvg + end interface + +contains + + subroutine foo_ext(foo_a) + use foo_type_mod + Type(foo_type) :: foo_a + + call foo_initvg(foo_a) + end subroutine foo_ext + +end module foo_mod +! { dg-final { cleanup-modules "foo_type_mod foo_mod" } } diff --git a/gcc/testsuite/gfortran.dg/used_types_15.f90 b/gcc/testsuite/gfortran.dg/used_types_15.f90 new file mode 100644 index 0000000..7f7dbb8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/used_types_15.f90 @@ -0,0 +1,35 @@ +! { dg-do compile } +! Tests the fix for PR31086 in which the chained derived types +! was not being associated. +! +! Contributed by Daniel Franke +! +MODULE class_dummy_atom_types +TYPE :: dummy_atom_list + TYPE(dummy_atom), DIMENSION(:), POINTER :: table +END TYPE + +TYPE :: dummy_atom + TYPE(dummy_atom_list) :: neighbours +END TYPE + +TYPE :: dummy_atom_model + TYPE(dummy_atom_list) :: atoms +END TYPE +END MODULE + +MODULE test_class_intensity_private +CONTAINS + SUBROUTINE change_phase(atom) + USE class_dummy_atom_types + TYPE(dummy_atom), INTENT(inout) :: atom + END SUBROUTINE + + SUBROUTINE simulate_cube() + USE class_dummy_atom_types + TYPE(dummy_atom) :: atom + TYPE(dummy_atom_model) :: dam + atom = dam%atoms%table(1) + END SUBROUTINE +END MODULE +! { dg-final { cleanup-modules "class_dummy_atom_types test_class_intensity_private" } } -- 2.7.4