2008-01-10 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/34396
	* trans-array.c (gfc_trans_array_ctor_element):  Use gfc_trans_string_copy
	to assign strings and perform bounds checks on the string length.
	(get_array_ctor_strlen): Remove bounds checking.
	(gfc_trans_array_constructor): Initialize string length checking.
	* trans-array.h : Add prototype for gfc_trans_string_copy.

2008-01-10  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/34396
	* gfortran.dg/bounds_check_12.f90: New test.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@131448 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 37 insertions, 21 deletions

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index f8d90820f9c..1718ba9cfae 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -951,18 +951,25 @@ gfc_put_offset_into_var (stmtblock_t * pblock, tree * poffset,
 
 
 /* Assign an element of an array constructor.  */
+static bool first_len;
+static tree first_len_val; 
 
 static void
 gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc,
 			      tree offset, gfc_se * se, gfc_expr * expr)
 {
   tree tmp;
+  tree esize;
 
   gfc_conv_expr (se, expr);
 
   /* Store the value.  */
   tmp = build_fold_indirect_ref (gfc_conv_descriptor_data_get (desc));
   tmp = gfc_build_array_ref (tmp, offset, NULL);
+
+  esize = size_in_bytes (gfc_get_element_type (TREE_TYPE (desc)));
+  esize = fold_convert (gfc_charlen_type_node, esize);
+
   if (expr->ts.type == BT_CHARACTER)
     {
       gfc_conv_string_parameter (se);
@@ -978,9 +985,30 @@ gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc,
 	  tmp = gfc_build_addr_expr (pchar_type_node, tmp);
 	  /* We know the temporary and the value will be the same length,
 	     so can use memcpy.  */
-	  tmp = build_call_expr (built_in_decls[BUILT_IN_MEMCPY], 3,
-				 tmp, se->expr, se->string_length);
-	  gfc_add_expr_to_block (&se->pre, tmp);
+	  gfc_trans_string_copy (&se->pre, esize, tmp,
+				 se->string_length,
+				 se->expr);
+	}
+      if (flag_bounds_check)
+	{
+	  if (first_len)
+	    {
+	      gfc_add_modify_expr (&se->pre, first_len_val,
+				   se->string_length);
+	      first_len = false;
+	    }
+	  else
+	    {
+	      /* Verify that all constructor elements are of the same
+		 length.  */
+	      tree cond = fold_build2 (NE_EXPR, boolean_type_node,
+				       first_len_val, se->string_length);
+	      gfc_trans_runtime_check
+		(cond, &se->pre, &expr->where,
+		 "Different CHARACTER lengths (%ld/%ld) in array constructor",
+		 fold_convert (long_integer_type_node, first_len_val),
+		 fold_convert (long_integer_type_node, se->string_length));
+	    }
 	}
     }
   else
@@ -1425,7 +1453,6 @@ bool
 get_array_ctor_strlen (stmtblock_t *block, gfc_constructor * c, tree * len)
 {
   bool is_const;
-  tree first_len = NULL_TREE;
   
   is_const = TRUE;
 
@@ -1460,23 +1487,6 @@ get_array_ctor_strlen (stmtblock_t *block, gfc_constructor * c, tree * len)
 	  get_array_ctor_all_strlen (block, c->expr, len);
 	  break;
 	}
-      if (flag_bounds_check)
-	{
-	  if (!first_len)
-	    first_len = *len;
-	  else
-	    {
-	      /* Verify that all constructor elements are of the same
-		 length.  */
-	      tree cond = fold_build2 (NE_EXPR, boolean_type_node,
-				       first_len, *len);
-	      gfc_trans_runtime_check
-		(cond, block, &c->expr->where,
-		 "Different CHARACTER lengths (%ld/%ld) in array constructor",
-		 fold_convert (long_integer_type_node, first_len),
-		 fold_convert (long_integer_type_node, *len));
-	    }
-	}
     }
 
   return is_const;
@@ -1660,6 +1670,12 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss)
   tree type;
   bool dynamic;
 
+  if (flag_bounds_check && ss->expr->ts.type == BT_CHARACTER)
+    {  
+      first_len_val = gfc_create_var (gfc_charlen_type_node, "len");
+      first_len = true;
+    }
+
   ss->data.info.dimen = loop->dimen;
 
   c = ss->expr->value.constructor;