re PR fortran/67177 (MOVE_ALLOC not automatically allocating deferred character arrays in derived types)

2015-10-18  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/67177
	PR fortran/67977
	* primary.c (match_substring): Add an argument 'deferred' to
	flag that a substring reference with null start and end should
	not be optimized away for deferred length strings.
	(match_string_constant, gfc_match_rvalue): Set the argument.
	* trans-expr.c (alloc_scalar_allocatable_for_assignment): If
	there is a substring reference return.
	* trans-intrinsic.c (conv_intrinsic_move_alloc): For deferred
	characters, assign the 'from' string length to the 'to' string
	length. If the 'from' expression is deferred, set its string
	length to zero. If the 'to' expression has allocatable
	components, deallocate them.

2015-10-18  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/67177
	* gfortran.dg/move_alloc_15.f90: New test
	* gfortran.dg/move_alloc_16.f90: New test

	PR fortran/67977
	* gfortran.dg/deferred_character_assignment_1.f90: New test

From-SVN: r228940

4 files changed, 58 insertions, 7 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 9c5bb76..51b07de 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,8 +1,24 @@
+2015-10-18  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/67177
+	PR fortran/67977
+	* primary.c (match_substring): Add an argument 'deferred' to
+	flag that a substring reference with null start and end should
+	not be optimized away for deferred length strings.
+	(match_string_constant, gfc_match_rvalue): Set the argument.
+	* trans-expr.c (alloc_scalar_allocatable_for_assignment): If
+	there is a substring reference return.
+	* trans-intrinsic.c (conv_intrinsic_move_alloc): For deferred
+	characters, assign the 'from' string length to the 'to' string
+	length. If the 'from' expression is deferred, set its string
+	length to zero. If the 'to' expression has allocatable
+	components, deallocate them.
+
 2015-10-17  Steven G. Kargl  <kargl@gcc.gnu.org>
 
 	PR fortran/67987
 	* decl.c (char_len_param_value): Unwrap unlong line.  If LEN < 0,
-	force it to zero per the Fortran 90, 95, 2003, and 2008 Standards. 
+	force it to zero per the Fortran 90, 95, 2003, and 2008 Standards.
 	* resolve.c (gfc_resolve_substring_charlen): Unwrap unlong line.
 	If 'start' is larger than 'end', length of substring is negative,
 	so explicitly set it to zero.
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 9f75666..e39c890 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -761,7 +761,7 @@ done:
 	{
 	  if (*p == '.')
 	    continue;
-	  
+
 	  if (*p != '0')
 	    {
 	      *p = '0';
@@ -800,7 +800,7 @@ cleanup:
 /* Match a substring reference.  */
 
 static match
-match_substring (gfc_charlen *cl, int init, gfc_ref **result)
+match_substring (gfc_charlen *cl, int init, gfc_ref **result, bool deferred)
 {
   gfc_expr *start, *end;
   locus old_loc;
@@ -852,7 +852,7 @@ match_substring (gfc_charlen *cl, int init, gfc_ref **result)
     }
 
   /* Optimize away the (:) reference.  */
-  if (start == NULL && end == NULL)
+  if (start == NULL && end == NULL && !deferred)
     ref = NULL;
   else
     {
@@ -1150,7 +1150,7 @@ got_delim:
   if (ret != -1)
     gfc_internal_error ("match_string_constant(): Delimiter not found");
 
-  if (match_substring (NULL, 0, &e->ref) != MATCH_NO)
+  if (match_substring (NULL, 0, &e->ref, false) != MATCH_NO)
     e->expr_type = EXPR_SUBSTRING;
 
   *result = e;
@@ -2133,7 +2133,8 @@ check_substring:
 
   if (primary->ts.type == BT_CHARACTER)
     {
-      switch (match_substring (primary->ts.u.cl, equiv_flag, &substring))
+      bool def = primary->ts.deferred == 1;
+      switch (match_substring (primary->ts.u.cl, equiv_flag, &substring, def))
 	{
 	case MATCH_YES:
 	  if (tail == NULL)
@@ -3147,7 +3148,7 @@ gfc_match_rvalue (gfc_expr **result)
 	     that we're not sure is a variable yet.  */
 
 	  if ((implicit_char || sym->ts.type == BT_CHARACTER)
-	      && match_substring (sym->ts.u.cl, 0, &e->ref) == MATCH_YES)
+	      && match_substring (sym->ts.u.cl, 0, &e->ref, false) == MATCH_YES)
 	    {
 
 	      e->expr_type = EXPR_VARIABLE;
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index e086fe3..2f42c04 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -8891,6 +8891,7 @@ alloc_scalar_allocatable_for_assignment (stmtblock_t *block,
   tree jump_label1;
   tree jump_label2;
   gfc_se lse;
+  gfc_ref *ref;
 
   if (!expr1 || expr1->rank)
     return;
@@ -8898,6 +8899,10 @@ alloc_scalar_allocatable_for_assignment (stmtblock_t *block,
   if (!expr2 || expr2->rank)
     return;
 
+  for (ref = expr1->ref; ref; ref = ref->next)
+    if (ref->type == REF_SUBSTRING)
+      return;
+
   realloc_lhs_warning (expr2->ts.type, false, &expr2->where);
 
   /* Since this is a scalar lhs, we can afford to do this.  That is,
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 15ef560..d72ea98 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -9414,6 +9414,16 @@ conv_intrinsic_move_alloc (gfc_code *code)
 	    }
 	}
 
+      if (to_expr->ts.type == BT_CHARACTER && to_expr->ts.deferred)
+	{
+	  gfc_add_modify_loc (input_location, &block, to_se.string_length,
+			      fold_convert (TREE_TYPE (to_se.string_length),
+					    from_se.string_length));
+	  if (from_expr->ts.deferred)
+	    gfc_add_modify_loc (input_location, &block, from_se.string_length,
+			build_int_cst (TREE_TYPE (from_se.string_length), 0));
+	}
+
       return gfc_finish_block (&block);
     }
 
@@ -9513,6 +9523,14 @@ conv_intrinsic_move_alloc (gfc_code *code)
     }
   else
     {
+      if (to_expr->ts.type == BT_DERIVED
+	  && to_expr->ts.u.derived->attr.alloc_comp)
+	{
+	  tmp = gfc_deallocate_alloc_comp (to_expr->ts.u.derived,
+					   to_se.expr, to_expr->rank);
+	  gfc_add_expr_to_block (&block, tmp);
+	}
+
       tmp = gfc_conv_descriptor_data_get (to_se.expr);
       tmp = gfc_deallocate_with_status (tmp, NULL_TREE, NULL_TREE, NULL_TREE,
 					NULL_TREE, true, to_expr, false);
@@ -9527,6 +9545,17 @@ conv_intrinsic_move_alloc (gfc_code *code)
   gfc_add_modify_loc (input_location, &block, tmp,
 		      fold_convert (TREE_TYPE (tmp), null_pointer_node));
 
+
+  if (to_expr->ts.type == BT_CHARACTER && to_expr->ts.deferred)
+    {
+      gfc_add_modify_loc (input_location, &block, to_se.string_length,
+			  fold_convert (TREE_TYPE (to_se.string_length),
+					from_se.string_length));
+      if (from_expr->ts.deferred)
+        gfc_add_modify_loc (input_location, &block, from_se.string_length,
+			build_int_cst (TREE_TYPE (from_se.string_length), 0));
+    }
+
   return gfc_finish_block (&block);
 }