re PR fortran/30531 ([4.2 only] allocatable component and intent(out) yield ICE in fold_convert)
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-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. From-SVN: r123037
This commit is contained in:
Paul Thomas
parent
f210f1cd67
commit
7453378e3d
8 changed files with 111 additions and 69 deletions
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ();
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
32
gcc/testsuite/gfortran.dg/used_types_14.f90
Normal file
32
gcc/testsuite/gfortran.dg/used_types_14.f90
Normal file
|
|
@ -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" } }
|
||||
35
gcc/testsuite/gfortran.dg/used_types_15.f90
Normal file
35
gcc/testsuite/gfortran.dg/used_types_15.f90
Normal file
|
|
@ -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" } }
|
||||
Loading…
Add table
Reference in a new issue