This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[gfortran] PR13010 Self-referential types.


The patch below fixes derived types that contain arrays of pointers to 
themselves.  We don't actually care what the size of the target is when 
laying out types containing pointers. This means we can build derived types 
recursively, using the (possibly incomplete) RECORD_TYPE node for types we've 
see before.

The only exception was the DTYPE field, ad there's no reason to calculate that 
until it is needed, ie. after all the types have been laid out.

Previous changes mean it's fairly tricky to write a test that shows this 
brokenness. I decided to punt, and just include the code from the PR.

Tested on i686-linux.
Applied to mainline.

Paul
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.
testsuite/
 * gfortran.dg/der_pointer_1.f90: New test.
Index: trans-array.c
===================================================================
RCS file: /var/cvsroot/gcc-cvs/gcc/gcc/fortran/trans-array.c,v
retrieving revision 1.30
diff -u -p -r1.30 trans-array.c
--- trans-array.c	8 Nov 2004 14:56:40 -0000	1.30
+++ trans-array.c	15 Nov 2004 23:14:14 -0000
@@ -569,8 +569,7 @@ gfc_trans_allocate_temp_array (gfc_loopi
 
   /* 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, in
 
   /* 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, g
 
       /* 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;
Index: trans-types.c
===================================================================
RCS file: /var/cvsroot/gcc-cvs/gcc/gcc/fortran/trans-types.c,v
retrieving revision 1.32
diff -u -p -r1.32 trans-types.c
--- trans-types.c	15 Nov 2004 16:32:20 -0000	1.32
+++ trans-types.c	16 Nov 2004 01:41:04 -0000
@@ -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, g
   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, i
   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 * deriv
       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
 	{
Index: trans-types.h
===================================================================
RCS file: /var/cvsroot/gcc-cvs/gcc/gcc/fortran/trans-types.h,v
retrieving revision 1.8
diff -u -p -r1.8 trans-types.h
--- trans-types.h	31 Aug 2004 14:06:47 -0000	1.8
+++ trans-types.h	15 Nov 2004 23:14:14 -0000
@@ -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
Index: trans.h
===================================================================
RCS file: /var/cvsroot/gcc-cvs/gcc/gcc/fortran/trans.h,v
retrieving revision 1.20
diff -u -p -r1.20 trans.h
--- trans.h	8 Nov 2004 14:56:41 -0000	1.20
+++ trans.h	15 Nov 2004 23:14:14 -0000
@@ -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)

Attachment: der_pointer_1.f90
Description: Text document


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]