Commit 40b026d8 by Paul Brook Committed by Paul Brook

re PR fortran/13010 (seg fault on valid code)

	PR fortran/13010
	* trans-array.c (gfc_trans_allocate_temp_array): Use gfc_get_dtype.
	(gfc_array_init_size, gfc_conv_expr_descriptor): Ditto.
	* trans-types.c (gfc_get_dtype): Accept array type rather than element
	type.
	(gfc_get_nodesc_array_type): Don't set GFC_TYPE_ARRAY_DTYPE.
	(gfc_get_array_type_bounds): Ditto.
	(gfc_get_derived_type): Recurse into derived type pointers.
	* trans-types.h (gfc_get_dtype): Add prototype.
	* trans.h (GFC_TYPE_ARRAY_DTYPE): Add comment.
testsuite/
	* gfortran.dg/der_pointer_1.f90: New test.

From-SVN: r90714
parent e61ec2dd
2004-11-16 Paul Brook <paul@codesourcery.com>
PR fortran/13010
* trans-array.c (gfc_trans_allocate_temp_array): Use gfc_get_dtype.
(gfc_array_init_size, gfc_conv_expr_descriptor): Ditto.
* trans-types.c (gfc_get_dtype): Accept array type rather than element
type.
(gfc_get_nodesc_array_type): Don't set GFC_TYPE_ARRAY_DTYPE.
(gfc_get_array_type_bounds): Ditto.
(gfc_get_derived_type): Recurse into derived type pointers.
* trans-types.h (gfc_get_dtype): Add prototype.
* trans.h (GFC_TYPE_ARRAY_DTYPE): Add comment.
2004-11-15 Paul Brook <paul@codesourcery.com>
* trans-types.c (gfc_get_dtype): Remove obsolete TODO.
......
......@@ -569,8 +569,7 @@ gfc_trans_allocate_temp_array (gfc_loopinfo * loop, gfc_ss_info * info,
/* Fill in the array dtype. */
tmp = gfc_conv_descriptor_dtype (desc);
gfc_add_modify_expr (&loop->pre, tmp,
GFC_TYPE_ARRAY_DTYPE (TREE_TYPE (desc)));
gfc_add_modify_expr (&loop->pre, tmp, gfc_get_dtype (TREE_TYPE (desc)));
/*
Fill in the bounds and stride. This is a packed array, so:
......@@ -2658,8 +2657,7 @@ gfc_array_init_size (tree descriptor, int rank, tree * poffset,
/* Set the dtype. */
tmp = gfc_conv_descriptor_dtype (descriptor);
gfc_add_modify_expr (pblock, tmp,
GFC_TYPE_ARRAY_DTYPE (TREE_TYPE (descriptor)));
gfc_add_modify_expr (pblock, tmp, gfc_get_dtype (TREE_TYPE (descriptor)));
for (n = 0; n < rank; n++)
{
......@@ -3771,7 +3769,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
/* Set the dtype. */
tmp = gfc_conv_descriptor_dtype (parm);
gfc_add_modify_expr (&loop.pre, tmp, GFC_TYPE_ARRAY_DTYPE (parmtype));
gfc_add_modify_expr (&loop.pre, tmp, gfc_get_dtype (parmtype));
if (se->direct_byref)
base = gfc_index_zero_node;
......
......@@ -848,19 +848,32 @@ gfc_get_desc_dim_type (void)
return type;
}
static tree
gfc_get_dtype (tree type, int rank)
/* Return the DTYPE for an array. This desribes the type and type parameters
of the array. */
/* TODO: Only call this when the value is actually used, and make all the
unknown cases abort. */
tree
gfc_get_dtype (tree type)
{
tree size;
int n;
HOST_WIDE_INT i;
tree tmp;
tree dtype;
tree etype;
int rank;
gcc_assert (GFC_DESCRIPTOR_TYPE_P (type) || GFC_ARRAY_TYPE_P (type));
if (GFC_DESCRIPTOR_TYPE_P (type) || GFC_ARRAY_TYPE_P (type))
return (GFC_TYPE_ARRAY_DTYPE (type));
if (GFC_TYPE_ARRAY_DTYPE (type))
return GFC_TYPE_ARRAY_DTYPE (type);
switch (TREE_CODE (type))
rank = GFC_TYPE_ARRAY_RANK (type);
etype = gfc_get_element_type (type);
switch (TREE_CODE (etype))
{
case INTEGER_TYPE:
n = GFC_DTYPE_INTEGER;
......@@ -878,7 +891,7 @@ gfc_get_dtype (tree type, int rank)
n = GFC_DTYPE_COMPLEX;
break;
/* Arrays have already been dealt with. */
/* We will never have arrays of arrays. */
case RECORD_TYPE:
n = GFC_DTYPE_DERIVED;
break;
......@@ -894,7 +907,7 @@ gfc_get_dtype (tree type, int rank)
}
gcc_assert (rank <= GFC_DTYPE_RANK_MASK);
size = TYPE_SIZE_UNIT (type);
size = TYPE_SIZE_UNIT (etype);
i = rank | (n << GFC_DTYPE_TYPE_SHIFT);
if (size && INTEGER_CST_P (size))
......@@ -917,6 +930,7 @@ gfc_get_dtype (tree type, int rank)
/* TODO: Check this is actually true, particularly when repacking
assumed size parameters. */
GFC_TYPE_ARRAY_DTYPE (type) = dtype;
return dtype;
}
......@@ -1027,8 +1041,8 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, int packed)
else
GFC_TYPE_ARRAY_SIZE (type) = NULL_TREE;
GFC_TYPE_ARRAY_DTYPE (type) = gfc_get_dtype (etype, as->rank);
GFC_TYPE_ARRAY_RANK (type) = as->rank;
GFC_TYPE_ARRAY_DTYPE (type) = NULL_TREE;
range = build_range_type (gfc_array_index_type, gfc_index_zero_node,
NULL_TREE);
/* TODO: use main type if it is unbounded. */
......@@ -1091,7 +1105,7 @@ gfc_get_array_type_bounds (tree etype, int dimen, tree * lbound,
TYPE_LANG_SPECIFIC (fat_type) = (struct lang_type *)
ggc_alloc_cleared (sizeof (struct lang_type));
GFC_TYPE_ARRAY_RANK (fat_type) = dimen;
GFC_TYPE_ARRAY_DTYPE (fat_type) = gfc_get_dtype (etype, dimen);
GFC_TYPE_ARRAY_DTYPE (fat_type) = NULL_TREE;
tmp = TYPE_NAME (etype);
if (tmp && TREE_CODE (tmp) == TYPE_DECL)
......@@ -1369,15 +1383,12 @@ gfc_get_derived_type (gfc_symbol * derived)
if (c->ts.type == BT_DERIVED && c->pointer)
{
if (c->ts.derived->backend_decl)
/* We already saw this derived type so use the exiting type.
It doesn't matter if it is incomplete. */
field_type = c->ts.derived->backend_decl;
else
{
/* Build the type node. */
field_type = make_node (RECORD_TYPE);
TYPE_NAME (field_type) = get_identifier (c->ts.derived->name);
TYPE_PACKED (field_type) = gfc_option.flag_pack_derived;
c->ts.derived->backend_decl = field_type;
}
/* Recurse into the type. */
field_type = gfc_get_derived_type (c->ts.derived);
}
else
{
......
......@@ -92,4 +92,7 @@ int gfc_return_by_reference (gfc_symbol *);
/* Returns true if the array sym does not require a descriptor. */
int gfc_is_nodesc_array (gfc_symbol *);
/* Return the DTYPE for an array. */
tree gfc_get_dtype (tree);
#endif
......@@ -553,6 +553,8 @@ struct lang_decl GTY(())
#define GFC_TYPE_ARRAY_RANK(node) (TYPE_LANG_SPECIFIC(node)->rank)
#define GFC_TYPE_ARRAY_SIZE(node) (TYPE_LANG_SPECIFIC(node)->size)
#define GFC_TYPE_ARRAY_OFFSET(node) (TYPE_LANG_SPECIFIC(node)->offset)
/* Code should use gfc_get_dtype instead of accesig this directly. It may
not be known when the type is created. */
#define GFC_TYPE_ARRAY_DTYPE(node) (TYPE_LANG_SPECIFIC(node)->dtype)
#define GFC_TYPE_ARRAY_DATAPTR_TYPE(node) \
(TYPE_LANG_SPECIFIC(node)->dataptr_type)
......
2004-11-16 Paul Brook <paul@codesourcery.com>
PR fortran/13010
* gfortran.dg/der_pointer_1.f90: New test.
2004-11-15 Joseph S. Myers <joseph@codesourcery.com>
PR c/18498
......
! { dg-do compile }
! PR13010
! Arrays of self-referential pointers
module test
type list_t
type(list_t), pointer :: next
end type list_t
type listptr_t
type(list_t), pointer :: this
end type listptr_t
type x_t
type(listptr_t), pointer :: arr(:)
end type x_t
type(x_t), pointer :: x
end module test
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment