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, 27 insertions, 3 deletions

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 929cbda..a0305a6 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1377,8 +1377,8 @@ gfc_get_symbol_decl (gfc_symbol * sym)
 	&& TREE_CODE (sym->ts.u.cl->backend_decl) == PARM_DECL)
     {
       sym->ts.u.cl->passed_length = sym->ts.u.cl->backend_decl;
-      sym->ts.u.cl->backend_decl = NULL_TREE;
-      length = gfc_create_string_length (sym);
+      gcc_assert (POINTER_TYPE_P (TREE_TYPE (sym->ts.u.cl->passed_length)));
+      sym->ts.u.cl->backend_decl = build_fold_indirect_ref (sym->ts.u.cl->backend_decl);
     }
 
   fun_or_res = byref && (sym->attr.result
@@ -1420,9 +1420,12 @@ gfc_get_symbol_decl (gfc_symbol * sym)
 		  /* We need to insert a indirect ref for param decls.  */
 		  if (sym->ts.u.cl->backend_decl
 		      && TREE_CODE (sym->ts.u.cl->backend_decl) == PARM_DECL)
+		    {
+		      sym->ts.u.cl->passed_length = sym->ts.u.cl->backend_decl;
 		    sym->ts.u.cl->backend_decl =
 			build_fold_indirect_ref (sym->ts.u.cl->backend_decl);
 		}
+		}
 	      /* For all other parameters make sure, that they are copied so
 		 that the value and any modifications are local to the routine
 		 by generating a temporary variable.  */
@@ -1431,6 +1434,10 @@ gfc_get_symbol_decl (gfc_symbol * sym)
 		       && sym->ts.u.cl->backend_decl)
 		{
 		  sym->ts.u.cl->passed_length = sym->ts.u.cl->backend_decl;
+		  if (POINTER_TYPE_P (TREE_TYPE (sym->ts.u.cl->passed_length)))
+		    sym->ts.u.cl->backend_decl
+			= build_fold_indirect_ref (sym->ts.u.cl->backend_decl);
+		  else
 		  sym->ts.u.cl->backend_decl = NULL_TREE;
 		}
 	    }
@@ -2264,6 +2271,13 @@ create_function_arglist (gfc_symbol * sym)
 	      type = gfc_sym_type (arg);
 	      arg->backend_decl = backend_decl;
 	      type = build_reference_type (type);
+
+	      if (POINTER_TYPE_P (len_type))
+		{
+		  sym->ts.u.cl->passed_length = length;
+		  sym->ts.u.cl->backend_decl =
+		    build_fold_indirect_ref_loc (input_location, length);
+		}
 	    }
 	}
 
@@ -2347,7 +2361,10 @@ create_function_arglist (gfc_symbol * sym)
 	  if (f->sym->ts.u.cl->backend_decl == NULL
 	      || f->sym->ts.u.cl->backend_decl == length)
 	    {
-	      if (f->sym->ts.u.cl->backend_decl == NULL)
+	      if (POINTER_TYPE_P (len_type))
+		f->sym->ts.u.cl->backend_decl =
+			build_fold_indirect_ref_loc (input_location, length);
+	      else if (f->sym->ts.u.cl->backend_decl == NULL)
 		gfc_create_string_length (f->sym);
 
 	      /* Make sure PARM_DECL type doesn't point to incomplete type.  */
@@ -3975,12 +3992,19 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
 	      gfc_restore_backend_locus (&loc);
 
 	      /* Pass back the string length on exit.  */
+	      tmp = proc_sym->ts.u.cl->backend_decl;
+	      if (TREE_CODE (tmp) != INDIRECT_REF)
+		{
 	      tmp = proc_sym->ts.u.cl->passed_length;
 	      tmp = build_fold_indirect_ref_loc (input_location, tmp);
 	      tmp = fold_convert (gfc_charlen_type_node, tmp);
 	      tmp = fold_build2_loc (input_location, MODIFY_EXPR,
 				     gfc_charlen_type_node, tmp,
 				     proc_sym->ts.u.cl->backend_decl);
+		}
+	      else
+		tmp = NULL_TREE;
+
 	      gfc_add_init_cleanup (block, gfc_finish_block (&init), tmp);
 	    }
 	  else if (TREE_CODE (proc_sym->ts.u.cl->backend_decl) == VAR_DECL)