diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 20 | ||||
| -rw-r--r-- | gcc/fortran/gfortran.h | 5 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 23 | ||||
| -rw-r--r-- | gcc/fortran/symbol.c | 15 | ||||
| -rw-r--r-- | gcc/fortran/trans-types.c | 42 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 8 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/used_types_14.f90 | 32 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/used_types_15.f90 | 35 |
8 files changed, 111 insertions, 69 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 76305392a7e..9ba65443de3 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,4 +1,22 @@ -2007-03-17 Francois-Xavier Coudert <coudert@clipper.ens.fr> +2007-03-18 Paul Thomas <pault@gcc.gnu.org> + + 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 <coudert@clipper.ens.fr> 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 b806f18cea9..6da8a9333e5 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 db55c0c5cc2..a72047e3ffb 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 8f2ab83b56a..7bf9aecf957 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 16121891a39..db93a109045 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 2a61218812a..51540e3e8de 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2007-03-18 Paul Thomas <pault@gcc.gnu.org> + + 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 <dorit@il.ibm.com> * 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 00000000000..3316b4ad02c --- /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 <sfilippone@uniroma2.it> +! +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 00000000000..7f7dbb8e139 --- /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 <dfranke@gcc.gnu.org> +! +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" } } |