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

7 files changed, 72 insertions, 22 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 826cdb3..86ddef6 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,16 @@
+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.
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 6380bcf..330c34b 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -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;
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index a2197e7..92b3625 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -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_TYPE_ARRAY_DTYPE (type))
+    return GFC_TYPE_ARRAY_DTYPE (type);
 
-  if (GFC_DESCRIPTOR_TYPE_P (type) || GFC_ARRAY_TYPE_P (type))
-    return (GFC_TYPE_ARRAY_DTYPE (type));
+  rank = GFC_TYPE_ARRAY_RANK (type);
+  etype = gfc_get_element_type (type);
 
-  switch (TREE_CODE (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)
-            field_type = 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
 	{
diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h
index 7a57961..647a62a 100644
--- a/gcc/fortran/trans-types.h
+++ b/gcc/fortran/trans-types.h
@@ -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
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 33d422a..f347724 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -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)
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 4ea1f12..b14148d 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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
diff --git a/gcc/testsuite/gfortran.dg/der_pointer_1.f90 b/gcc/testsuite/gfortran.dg/der_pointer_1.f90
new file mode 100644
index 0000000..bf4ffc3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/der_pointer_1.f90
@@ -0,0 +1,18 @@
+! { 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