re PR fortran/29396 (segfault with character pointer association)

2007-09-16  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/29396
	PR fortran/29606
	PR fortran/30625
	PR fortran/30871
	* trans.h : Add extra argument to gfc_build_array_ref. Rename
	gfc_conv_aliased_arg to gfc_conv_subref_array_arg.  Move
	prototype of is_aliased_array to gfortran.h and rename it
	gfc_is_subref_array.  Add field span to lang_decl, add a new
	decl lang specific flag accessed by GFC_DECL_SUBREF_ARRAY_P
	and a new type flag GFC_DECL_SUBREF_ARRAY_P.
	* trans.c (gfc_build_array_ref): Add the new argument, decl.
	If this is a subreference array pointer, use the lang_decl
	field 'span' to calculate the offset in bytes and use pointer
	arithmetic to address the element.
	* trans-array.c (gfc_conv_scalarized_array_ref,
	gfc_conv_array_ref): Add the backend declaration as the third
	field, if it is likely to be a subreference array pointer.
	(gfc_conv_descriptor_dimension, gfc_trans_array_ctor_element,
	gfc_trans_array_constructor_element, structure_alloc_comps,
	gfc_conv_array_index_offset): For all other references to
	gfc_build_array_ref, set the third argument to NULL.
	(gfc_get_dataptr_offset): New function.
	(gfc_conv_expr_descriptor): If the rhs of a pointer assignment
	is a subreference array, then calculate the offset to the
	subreference of the first element and set the descriptor data
	pointer to this, using gfc_get_dataptr_offset.
	trans-expr.c (gfc_get_expr_charlen): Use the expression for the
	character length for a character subreference.
	(gfc_conv_substring, gfc_conv_subref_array_arg): Add NULL for
	third argument in call to gfc_build_array_ref.
	(gfc_conv_aliased_arg): Rename to gfc_conv_subref_array_arg.
	(is_aliased_array): Remove.
	(gfc_conv_function_call): Change reference to is_aliased_array
	to gfc_is_subref_array and reference to gfc_conv_aliased_arg to
	gfc_conv_subref_array_arg.
	(gfc_trans_pointer_assignment): Add the array element length to
	the lang_decl 'span' field.
	* gfortran.h : Add subref_array_pointer to symbol_attribute and
	add the prototype for gfc_is_subref_array.
	* trans-stmt.c : Add NULL for third argument in all references
	to gfc_build_array_ref.
	* expr.c (gfc_is_subref_array): Renamed is_aliased_array.
	If this is a subreference array pointer, return true.
	(gfc_check_pointer_assign): If the rhs is a subreference array,
	set the lhs subreference_array_pointer attribute.
	* trans-decl.c (gfc_get_symbol_decl): Allocate the lang_decl
	field if the symbol is a subreference array pointer and set an
	initial value of zero for the 'span' field.
	* trans-io.c (set_internal_unit): Refer to is_subref_array and
	gfc_conv_subref_array_arg.
	(nml_get_addr_expr): Add NULL third argument to
	gfc_build_array_ref. 
	(gfc_trans_transfer): Use the scalarizer for a subreference
	array.

2007-09-16  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/29396
	PR fortran/29606
	PR fortran/30625
	PR fortran/30871
	* gfortran.dg/subref_array_pointer_1.f90: New test.
	* gfortran.dg/subref_array_pointer_2.f90: New test.

From-SVN: r128523

1 files changed, 33 insertions, 32 deletions

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index b6eb33a..f5d7c65 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -183,6 +183,15 @@ gfc_get_expr_charlen (gfc_expr *e)
   
   length = NULL; /* To silence compiler warning.  */
 
+  if (is_subref_array (e) && e->ts.cl->length)
+    {
+      gfc_se tmpse;
+      gfc_init_se (&tmpse, NULL);
+      gfc_conv_expr_type (&tmpse, e->ts.cl->length, gfc_charlen_type_node);
+      e->ts.cl->backend_decl = tmpse.expr;
+      return tmpse.expr;
+    }
+
   /* First candidate: if the variable is of type CHARACTER, the
      expression's length could be the length of the character
      variable.  */
@@ -207,6 +216,7 @@ gfc_get_expr_charlen (gfc_expr *e)
 	  /* We should never got substring references here.  These will be
 	     broken down by the scalarizer.  */
 	  gcc_unreachable ();
+	  break;
 	}
     }
 
@@ -270,7 +280,7 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
 	tmp = se->expr;
       else
 	tmp = build_fold_indirect_ref (se->expr);
-      tmp = gfc_build_array_ref (tmp, start.expr);
+      tmp = gfc_build_array_ref (tmp, start.expr, NULL);
       se->expr = gfc_build_addr_expr (type, tmp);
     }
 
@@ -1782,15 +1792,13 @@ gfc_apply_interface_mapping (gfc_interface_mapping * mapping,
   gfc_free_expr (expr);
 }
 
+
 /* Returns a reference to a temporary array into which a component of
    an actual argument derived type array is copied and then returned
-   after the function call.
-   TODO Get rid of this kludge, when array descriptors are capable of
-   handling arrays with a bigger stride in bytes than size.  */
-
+   after the function call.  */
 void
-gfc_conv_aliased_arg (gfc_se * parmse, gfc_expr * expr,
-		      int g77, sym_intent intent)
+gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr,
+			   int g77, sym_intent intent)
 {
   gfc_se lse;
   gfc_se rse;
@@ -1962,7 +1970,7 @@ gfc_conv_aliased_arg (gfc_se * parmse, gfc_expr * expr,
 
   /* Now use the offset for the reference.  */
   tmp = build_fold_indirect_ref (info->data);
-  rse.expr = gfc_build_array_ref (tmp, tmp_index);
+  rse.expr = gfc_build_array_ref (tmp, tmp_index, NULL);
 
   if (expr->ts.type == BT_CHARACTER)
     rse.string_length = expr->ts.cl->backend_decl;
@@ -2005,28 +2013,6 @@ gfc_conv_aliased_arg (gfc_se * parmse, gfc_expr * expr,
   return;
 }
 
-/* Is true if an array reference is followed by a component or substring
-   reference.  */
-
-bool
-is_aliased_array (gfc_expr * e)
-{
-  gfc_ref * ref;
-  bool seen_array;
-
-  seen_array = false;	
-  for (ref = e->ref; ref; ref = ref->next)
-    {
-      if (ref->type == REF_ARRAY
-	    && ref->u.ar.type != AR_ELEMENT)
-	seen_array = true;
-
-      if (seen_array
-	    && ref->type != REF_ARRAY)
-	return seen_array;
-    }
-  return false;
-}
 
 /* Generate the code for argument list functions.  */
 
@@ -2256,12 +2242,12 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
 	      f = f || !sym->attr.always_explicit;
 
 	      if (e->expr_type == EXPR_VARIABLE
-		    && is_aliased_array (e))
+		    && is_subref_array (e))
 		/* The actual argument is a component reference to an
 		   array of derived types.  In this case, the argument
 		   is converted to a temporary, which is passed and then
 		   written back after the procedure call.  */
-		gfc_conv_aliased_arg (&parmse, e, f,
+		gfc_conv_subref_array_arg (&parmse, e, f,
 			fsym ? fsym->attr.intent : INTENT_INOUT);
 	      else
 	        gfc_conv_array_parameter (&parmse, e, argss, f);
@@ -3471,6 +3457,8 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
   stmtblock_t block;
   tree desc;
   tree tmp;
+  tree decl;
+
 
   gfc_start_block (&block);
 
@@ -3509,6 +3497,19 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
 	  /* Assign directly to the pointer's descriptor.  */
           lse.direct_byref = 1;
 	  gfc_conv_expr_descriptor (&lse, expr2, rss);
+
+	  /* If this is a subreference array pointer assignment, use the rhs
+	     element size for the lhs span.  */
+	  if (expr1->symtree->n.sym->attr.subref_array_pointer)
+	    {
+	      decl = expr1->symtree->n.sym->backend_decl;
+	      tmp = rss->data.info.descriptor;
+	      tmp = gfc_get_element_type (TREE_TYPE (tmp));
+	      tmp = size_in_bytes (tmp);
+	      tmp = fold_convert (gfc_array_index_type, tmp);
+	      gfc_add_modify_expr (&lse.post, GFC_DECL_SPAN(decl), tmp);
+	    }
+
 	  break;
 
 	default: