re PR fortran/64324 (Deferred character specific functions not permitted in generic operator interface)

2016-01-15  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/64324
	* resolve.c (check_uop_procedure): Prevent deferred length
	characters from being trapped by assumed length error.

	PR fortran/49630
	PR fortran/54070
	PR fortran/60593
	PR fortran/60795
	PR fortran/61147
	PR fortran/64324
	* trans-array.c (gfc_conv_scalarized_array_ref): Pass decl for
	function as well as variable expressions.
	(gfc_array_init_size): Add 'expr' as an argument. Use this to
	correctly set the descriptor dtype for deferred characters.
	(gfc_array_allocate): Add 'expr' to the call to
	'gfc_array_init_size'.
	* trans.c (gfc_build_array_ref): Expand logic for setting span
	to include indirect references to character lengths.
	* trans-decl.c (gfc_get_symbol_decl): Ensure that deferred
	result char lengths that are PARM_DECLs are indirectly
	referenced both for directly passed and by reference.
	(create_function_arglist): If the length type is a pointer type
	then store the length as the 'passed_length' and make the char
	length an indirect reference to it.
	(gfc_trans_deferred_vars): If a character length has escaped
	being set as an indirect reference, return it via the 'passed
	length'.
	* trans-expr.c (gfc_conv_procedure_call): The length of
	deferred character length results is set TREE_STATIC and set to
	zero.
	(gfc_trans_assignment_1): Do not fix the rse string_length if
	it is a variable, a parameter or an indirect reference. Add the
	code to trap assignment of scalars to unallocated arrays.
	* trans-stmt.c (gfc_trans_allocate): Remove 'def_str_len' and
	all references to it. Instead, replicate the code to obtain a
	explicitly defined string length and provide a value before
	array allocation so that the dtype is correctly set.
	trans-types.c (gfc_get_character_type): If the character length
	is a pointer, use the indirect reference.

2016-01-15  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/49630
	* gfortran.dg/deferred_character_13.f90: New test for the fix
	of comment 3 of the PR.

	PR fortran/54070
	* gfortran.dg/deferred_character_8.f90: New test
	* gfortran.dg/allocate_error_5.f90: New test

	PR fortran/60593
	* gfortran.dg/deferred_character_10.f90: New test

	PR fortran/60795
	* gfortran.dg/deferred_character_14.f90: New test

	PR fortran/61147
	* gfortran.dg/deferred_character_11.f90: New test

	PR fortran/64324
	* gfortran.dg/deferred_character_9.f90: New test

From-SVN: r232450

1 files changed, 32 insertions, 1 deletions

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 1a6b734..863e2aa 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -5942,6 +5942,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	  tmp = len;
 	  if (TREE_CODE (tmp) != VAR_DECL)
 	    tmp = gfc_evaluate_now (len, &se->pre);
+	  TREE_STATIC (tmp) = 1;
+	  gfc_add_modify (&se->pre, tmp,
+			  build_int_cst (TREE_TYPE (tmp), 0));
 	  tmp = gfc_build_addr_expr (NULL_TREE, tmp);
 	  vec_safe_push (retargs, tmp);
 	}
@@ -9263,7 +9266,10 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
     }
 
   /* Stabilize a string length for temporaries.  */
-  if (expr2->ts.type == BT_CHARACTER && !expr2->ts.deferred)
+  if (expr2->ts.type == BT_CHARACTER && !expr1->ts.deferred
+      && !(TREE_CODE (rse.string_length) == VAR_DECL
+	   || TREE_CODE (rse.string_length) == PARM_DECL
+	   || TREE_CODE (rse.string_length) == INDIRECT_REF))
     string_length = gfc_evaluate_now (rse.string_length, &rse.pre);
   else if (expr2->ts.type == BT_CHARACTER)
     string_length = rse.string_length;
@@ -9277,7 +9283,32 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
 	lse.string_length = string_length;
     }
   else
+    {
     gfc_conv_expr (&lse, expr1);
+      if (gfc_option.rtcheck & GFC_RTCHECK_MEM
+	  && gfc_expr_attr (expr1).allocatable
+	  && expr1->rank
+	  && !expr2->rank)
+	{
+	  tree cond;
+	  const char* msg;
+
+	  tmp = expr1->symtree->n.sym->backend_decl;
+	  if (POINTER_TYPE_P (TREE_TYPE (tmp)))
+	    tmp = build_fold_indirect_ref_loc (input_location, tmp);
+
+	  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
+	    tmp = gfc_conv_descriptor_data_get (tmp);
+	  else
+	    tmp = TREE_OPERAND (lse.expr, 0);
+
+	  cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+				  tmp, build_int_cst (TREE_TYPE (tmp), 0));
+	  msg = _("Assignment of scalar to unallocated array");
+	  gfc_trans_runtime_check (true, false, cond, &loop.pre,
+				   &expr1->where, msg);
+	}
+    }
 
   /* Assignments of scalar derived types with allocatable components
      to arrays must be done with a deep copy and the rhs temporary