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

17 files changed, 495 insertions, 29 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 051c6ed..5ad05ce 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,45 @@
+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-10  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	PR fortran/69154
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 2c839f9..64d59ce 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -15320,9 +15320,9 @@ check_uop_procedure (gfc_symbol *sym, locus where)
     }
 
   if (sym->ts.type == BT_CHARACTER
-      && !(sym->ts.u.cl && sym->ts.u.cl->length)
-      && !(sym->result && sym->result->ts.u.cl
-	   && sym->result->ts.u.cl->length))
+      && !((sym->ts.u.cl && sym->ts.u.cl->length) || sym->ts.deferred)
+      && !(sym->result && ((sym->result->ts.u.cl
+	   && sym->result->ts.u.cl->length) || sym->result->ts.deferred)))
     {
       gfc_error ("User operator procedure %qs at %L cannot be assumed "
 		 "character length", sym->name, &where);
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index a46f103..eeb688c 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -3165,7 +3165,8 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar)
 			     index, info->offset);
 
   if (expr && (is_subref_array (expr)
-	       || (expr->ts.deferred && expr->expr_type == EXPR_VARIABLE)))
+	       || (expr->ts.deferred && (expr->expr_type == EXPR_VARIABLE
+					 || expr->expr_type == EXPR_FUNCTION))))
     decl = expr->symtree->n.sym->backend_decl;
 
   tmp = build_fold_indirect_ref_loc (input_location, info->data);
@@ -5038,7 +5039,7 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
 		     gfc_expr ** lower, gfc_expr ** upper, stmtblock_t * pblock,
 		     stmtblock_t * descriptor_block, tree * overflow,
 		     tree expr3_elem_size, tree *nelems, gfc_expr *expr3,
-		     tree expr3_desc, bool e3_is_array_constr)
+		     tree expr3_desc, bool e3_is_array_constr, gfc_expr *expr)
 {
   tree type;
   tree tmp;
@@ -5063,8 +5064,19 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
   offset = gfc_index_zero_node;
 
   /* Set the dtype.  */
-  tmp = gfc_conv_descriptor_dtype (descriptor);
-  gfc_add_modify (descriptor_block, tmp, gfc_get_dtype (type));
+  if (expr->ts.type == BT_CHARACTER && expr->ts.deferred
+      && TREE_CODE (expr->ts.u.cl->backend_decl) == VAR_DECL)
+    {
+      type = gfc_typenode_for_spec (&expr->ts);
+      tmp = gfc_conv_descriptor_dtype (descriptor);
+      gfc_add_modify (descriptor_block, tmp,
+		      gfc_get_dtype_rank_type (rank, type));
+    }
+  else
+    {
+      tmp = gfc_conv_descriptor_dtype (descriptor);
+      gfc_add_modify (descriptor_block, tmp, gfc_get_dtype (type));
+    }
 
   or_expr = boolean_false_node;
 
@@ -5446,7 +5458,7 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
 			      ref->u.ar.as->corank, &offset, lower, upper,
 			      &se->pre, &set_descriptor_block, &overflow,
 			      expr3_elem_size, nelems, expr3, e3_arr_desc,
-			      e3_is_array_constr);
+			      e3_is_array_constr, expr);
 
   if (dimension)
     {
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)
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
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 70a61cc..310d2cd 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -1437,7 +1437,7 @@ gfc_trans_critical (gfc_code *code)
 			  tree_cons (NULL_TREE, tmp, NULL_TREE),
 			  NULL_TREE);
       ASM_VOLATILE_P (tmp) = 1;
-  
+
       gfc_add_expr_to_block (&block, tmp);
     }
 
@@ -5298,7 +5298,6 @@ gfc_trans_allocate (gfc_code * code)
   tree label_finish;
   tree memsz;
   tree al_vptr, al_len;
-  tree def_str_len = NULL_TREE;
   /* If an expr3 is present, then store the tree for accessing its
      _vptr, and _len components in the variables, respectively.  The
      element size, i.e. _vptr%size, is stored in expr3_esize.  Any of
@@ -5688,7 +5687,6 @@ gfc_trans_allocate (gfc_code * code)
 	  expr3_esize = fold_build2_loc (input_location, MULT_EXPR,
 					 TREE_TYPE (se_sz.expr),
 					 tmp, se_sz.expr);
-	  def_str_len = gfc_evaluate_now (se_sz.expr, &block);
 	}
     }
 
@@ -5741,16 +5739,6 @@ gfc_trans_allocate (gfc_code * code)
       se.want_pointer = 1;
       se.descriptor_only = 1;
 
-      if (expr->ts.type == BT_CHARACTER
-	  && expr->ts.deferred
-	  && TREE_CODE (expr->ts.u.cl->backend_decl) == VAR_DECL
-	  && def_str_len != NULL_TREE)
-	{
-	  tmp = expr->ts.u.cl->backend_decl;
-	  gfc_add_modify (&block, tmp,
-			  fold_convert (TREE_TYPE (tmp), def_str_len));
-	}
-
       gfc_conv_expr (&se, expr);
       if (expr->ts.type == BT_CHARACTER && expr->ts.deferred)
 	/* se.string_length now stores the .string_length variable of expr
@@ -5888,6 +5876,20 @@ gfc_trans_allocate (gfc_code * code)
 	      /* Prevent setting the length twice.  */
 	      al_len_needs_set = false;
 	    }
+	  else if (expr->ts.type == BT_CHARACTER && al_len != NULL_TREE
+		   && code->ext.alloc.ts.u.cl->length)
+	    {
+	      /* Cover the cases where a string length is explicitly
+		 specified by a type spec for deferred length character
+		 arrays or unlimited polymorphic objects without a
+		 source= or mold= expression.  */
+	      gfc_init_se (&se_sz, NULL);
+	      gfc_conv_expr (&se_sz, code->ext.alloc.ts.u.cl->length);
+	      gfc_add_modify (&block, al_len,
+			      fold_convert (TREE_TYPE (al_len),
+					    se_sz.expr));
+	      al_len_needs_set = false;
+	    }
 	}
 
       gfc_add_block_to_block (&block, &se.pre);
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 12cce4d..f3d0841 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -1045,6 +1045,8 @@ gfc_get_character_type (int kind, gfc_charlen * cl)
   tree len;
 
   len = (cl == NULL) ? NULL_TREE : cl->backend_decl;
+  if (len && POINTER_TYPE_P (TREE_TYPE (len)))
+    len = build_fold_indirect_ref (len);
 
   return gfc_get_character_type_len (kind, len);
 }
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 44b85e8..e71430b 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -335,10 +335,13 @@ gfc_build_array_ref (tree base, tree offset, tree decl, tree vptr)
      references.  */
   if (type && TREE_CODE (type) == ARRAY_TYPE
       && TYPE_MAXVAL (TYPE_DOMAIN (type)) != NULL_TREE
-      && TREE_CODE (TYPE_MAXVAL (TYPE_DOMAIN (type))) == VAR_DECL
+      && (TREE_CODE (TYPE_MAXVAL (TYPE_DOMAIN (type))) == VAR_DECL
+	  || TREE_CODE (TYPE_MAXVAL (TYPE_DOMAIN (type))) == INDIRECT_REF)
       && decl
-      && DECL_CONTEXT (TYPE_MAXVAL (TYPE_DOMAIN (type)))
-					== DECL_CONTEXT (decl))
+      && (TREE_CODE (TYPE_MAXVAL (TYPE_DOMAIN (type))) == INDIRECT_REF
+	  || TREE_CODE (decl) == FUNCTION_DECL
+	  || DECL_CONTEXT (TYPE_MAXVAL (TYPE_DOMAIN (type)))
+					== DECL_CONTEXT (decl)))
     span = TYPE_MAXVAL (TYPE_DOMAIN (type));
   else
     span = NULL_TREE;
@@ -354,7 +357,8 @@ gfc_build_array_ref (tree base, tree offset, tree decl, tree vptr)
      and reference the element with pointer arithmetic.  */
   if ((decl && (TREE_CODE (decl) == FIELD_DECL
 		|| TREE_CODE (decl) == VAR_DECL
-		|| TREE_CODE (decl) == PARM_DECL)
+		|| TREE_CODE (decl) == PARM_DECL
+		|| TREE_CODE (decl) == FUNCTION_DECL)
        && ((GFC_DECL_SUBREF_ARRAY_P (decl)
 	    && !integer_zerop (GFC_DECL_SPAN (decl)))
 	   || GFC_DECL_CLASS (decl)
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 0a4e6e7..29291a2 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,25 @@
+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
+
 2016-01-15  Vladimir Makarov  <vmakarov@redhat.com>
 
 	PR rtl-optimization/69030
diff --git a/gcc/testsuite/gfortran.dg/allocate_error_5.f90 b/gcc/testsuite/gfortran.dg/allocate_error_5.f90
new file mode 100644
index 0000000..4e5f4bd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_error_5.f90
@@ -0,0 +1,23 @@
+! { dg-do run }
+! { dg-additional-options "-fcheck=mem" }
+! { dg-shouldfail "Fortran runtime error: Assignment of scalar to unallocated array" }
+!
+! This omission was encountered in the course of fixing PR54070. Whilst this is a
+! very specific case, others such as allocatable components have been tested.
+!
+! Contributed by Tobias Burnus  <burnus@gcc.gnu.org>
+!
+function g(a) result (res)
+  character(len=*) :: a
+  character(len=:),allocatable :: res(:)
+  res = a  ! Since 'res' is not allocated, a runtime error should occur.
+end function
+
+  interface
+    function g(a) result(res)
+      character(len=*) :: a
+      character(len=:),allocatable :: res(:)
+    end function
+  end interface
+  print *, g("ABC")
+end
diff --git a/gcc/testsuite/gfortran.dg/deferred_character_10.f90 b/gcc/testsuite/gfortran.dg/deferred_character_10.f90
new file mode 100644
index 0000000..6a36741
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/deferred_character_10.f90
@@ -0,0 +1,52 @@
+! { dg-do run }
+!
+! Checks that PR60593 is fixed (Revision: 214757)
+!
+! Contributed by Steve Kargl  <kargl@gcc.gnu.org>
+!
+! Main program added for this test.
+!
+module stringhelper_m
+
+  implicit none
+
+  type :: string_t
+     character(:), allocatable :: string
+  end type
+
+  interface len
+     function strlen(s) bind(c,name='strlen')
+       use iso_c_binding
+       implicit none
+       type(c_ptr), intent(in), value :: s
+       integer(c_size_t) :: strlen
+     end function
+  end interface
+
+  contains
+
+    function C2FChar(c_charptr) result(res)
+      use iso_c_binding
+      type(c_ptr), intent(in) :: c_charptr
+      character(:), allocatable :: res
+      character(kind=c_char,len=1), pointer :: string_p(:)
+      integer i, c_str_len
+      c_str_len = int(len(c_charptr))
+      call c_f_pointer(c_charptr, string_p, [c_str_len])
+      allocate(character(c_str_len) :: res)
+      forall (i = 1:c_str_len) res(i:i) = string_p(i)
+    end function
+
+end module
+
+  use stringhelper_m
+  use iso_c_binding
+  implicit none
+  type(c_ptr) :: cptr
+  character(20), target :: str
+
+  str = "abcdefghij"//char(0)
+  cptr = c_loc (str)
+  if (len (C2FChar (cptr)) .ne. 10) call abort
+  if (C2FChar (cptr) .ne. "abcdefghij") call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/deferred_character_11.f90 b/gcc/testsuite/gfortran.dg/deferred_character_11.f90
new file mode 100644
index 0000000..454cf47
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/deferred_character_11.f90
@@ -0,0 +1,39 @@
+! { dg-do run }
+!
+! Test the fix for PR61147.
+!
+! Contributed by Thomas Clune  <Thomas.L.Clune@nasa.gov>
+!
+module B_mod
+
+   type :: B
+      character(:), allocatable :: string
+   end type B
+
+contains
+
+   function toPointer(this) result(ptr)
+      character(:), pointer :: ptr
+      class (B), intent(in), target :: this
+
+         ptr => this%string
+
+   end function toPointer
+
+end module B_mod
+
+program main
+   use B_mod
+
+   type (B) :: obj
+   character(:), pointer :: p
+
+   obj%string = 'foo'
+   p => toPointer(obj)
+
+   If (len (p) .ne. 3) call abort
+   If (p .ne. "foo") call abort
+
+end program main
+
+
diff --git a/gcc/testsuite/gfortran.dg/deferred_character_12.f90 b/gcc/testsuite/gfortran.dg/deferred_character_12.f90
new file mode 100644
index 0000000..cdb6c89
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/deferred_character_12.f90
@@ -0,0 +1,37 @@
+! { dg-do run }
+!
+! Tests the fix for PR63232
+!
+! Contributed by Balint Aradi  <baradi09@gmail.com>
+!
+module mymod
+  implicit none
+
+  type :: wrapper
+    character(:), allocatable :: string
+  end type wrapper
+
+contains
+
+
+  subroutine sub2(mystring)
+    character(:), allocatable, intent(out) :: mystring
+
+    mystring = "test"
+
+  end subroutine sub2
+
+end module mymod
+
+
+program test
+  use mymod
+  implicit none
+
+  type(wrapper) :: mywrapper
+
+  call sub2(mywrapper%string)
+  if (.not. allocated(mywrapper%string)) call abort
+  if (trim(mywrapper%string) .ne. "test") call abort
+
+end program test
diff --git a/gcc/testsuite/gfortran.dg/deferred_character_13.f90 b/gcc/testsuite/gfortran.dg/deferred_character_13.f90
new file mode 100644
index 0000000..822cc5d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/deferred_character_13.f90
@@ -0,0 +1,34 @@
+! { dg-do run }
+!
+! Tests the fix for PR49630 comment #3.
+!
+! Contributed by Janus Weil  <janus@gcc.gnu.org>
+!
+module abc
+  implicit none
+
+  type::abc_type
+   contains
+     procedure::abc_function
+  end type abc_type
+
+contains
+
+  function abc_function(this)
+    class(abc_type),intent(in)::this
+    character(:),allocatable::abc_function
+    allocate(abc_function,source="hello")
+  end function abc_function
+
+  subroutine do_something(this)
+    class(abc_type),intent(in)::this
+    if (this%abc_function() .ne. "hello") call abort
+  end subroutine do_something
+
+end module abc
+
+
+  use abc
+  type(abc_type) :: a
+  call do_something(a)
+end
diff --git a/gcc/testsuite/gfortran.dg/deferred_character_14.f90 b/gcc/testsuite/gfortran.dg/deferred_character_14.f90
new file mode 100644
index 0000000..3c4163e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/deferred_character_14.f90
@@ -0,0 +1,30 @@
+! { dg-do run }
+!
+! Test fix for PR60795 comments #1 and  #4
+!
+! Contributed by Kergonath  <kergonath@me.com>
+!
+module m
+contains
+    subroutine allocate_array(s_array)
+        character(:), dimension(:), allocatable, intent(out) :: s_array
+
+        allocate(character(2) :: s_array(2))
+        s_array = ["ab","cd"]
+    end subroutine
+end module
+
+program stringtest
+    use m
+    character(:), dimension(:), allocatable :: s4
+    character(:), dimension(:), allocatable :: s
+! Comment #1
+    allocate(character(1) :: s(10))
+    if (size (s) .ne. 10) call abort
+    if (len (s) .ne. 1) call abort
+! Comment #4
+    call allocate_array(s4)
+    if (size (s4) .ne. 2) call abort
+    if (len (s4) .ne. 2) call abort
+    if (any (s4 .ne. ["ab", "cd"])) call abort
+ end program
diff --git a/gcc/testsuite/gfortran.dg/deferred_character_8.f90 b/gcc/testsuite/gfortran.dg/deferred_character_8.f90
new file mode 100644
index 0000000..009acc1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/deferred_character_8.f90
@@ -0,0 +1,84 @@
+! { dg-do run }
+!
+! Test the fix for all the remaining issues in PR54070. These were all
+! concerned with deferred length characters being returned as function results,
+! except for comment #23 where the descriptor dtype was not correctly set and
+! array IO failed in consequence.
+!
+! Contributed by Tobias Burnus  <burnus@gcc.gnu.org>
+!
+! The original comment #1 with an allocate statement.
+! Allocatable, deferred length scalar resul.
+function f()
+  character(len=:),allocatable :: f
+  allocate (f, source = "abc")
+  f ="ABC"
+end function
+!
+! Allocatable, deferred length, explicit, array result
+function g(a) result (res)
+  character(len=*) :: a(:)
+  character(len (a)) :: b(size (a))
+  character(len=:),allocatable :: res(:)
+  integer :: i
+  allocate (character(len(a)) :: res(2*size(a)))
+  do i = 1, len (a)
+    b(:)(i:i) = char (ichar (a(:)(i:i)) + 4)
+  end do
+  res = [a, b]
+end function
+!
+! Allocatable, deferred length, array result
+function h(a)
+  character(len=*) :: a(:)
+  character(len(a)) :: b (size(a))
+  character(len=:),allocatable :: h(:)
+  integer :: i
+  allocate (character(len(a)) :: h(size(a)))
+  do i = 1, len (a)
+    b(:)(i:i) = char (ichar (a(:)(i:i)) + 32)
+  end do
+  h = b
+end function
+
+module deferred_length_char_array
+contains
+  function return_string(argument)
+    character(*) :: argument
+    character(:), dimension(:), allocatable :: return_string
+    allocate (character (len(argument)) :: return_string(2))
+    return_string = argument
+  end function
+end module
+
+  use deferred_length_char_array
+  character(len=3) :: chr(3)
+  character(:), pointer :: s(:)
+  character(6) :: buffer
+  interface
+    function f()
+      character(len=:),allocatable :: f
+    end function
+    function g(a) result(res)
+      character(len=*) :: a(:)
+      character(len=:),allocatable :: res(:)
+    end function
+    function h(a)
+      character(len=*) :: a(:)
+      character(len=:),allocatable :: h(:)
+    end function
+  end interface
+
+  if (f () .ne. "ABC") call abort
+  if (any (g (["ab","cd"]) .ne. ["ab","cd","ef","gh"])) call abort
+  chr = h (["ABC","DEF","GHI"])
+  if (any (chr .ne. ["abc","def","ghi"])) call abort
+  if (any (return_string ("abcdefg") .ne. ["abcdefg","abcdefg"])) call abort
+
+! Comment #23
+  allocate(character(3)::s(2))
+  s(1) = 'foo'
+  s(2) = 'bar'
+  write (buffer, '(2A3)') s
+  if (buffer .ne. 'foobar') call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/deferred_character_9.f90 b/gcc/testsuite/gfortran.dg/deferred_character_9.f90
new file mode 100644
index 0000000..f88de7a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/deferred_character_9.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+!
+! Test the fix for PR64324 in which deferred length user ops
+! were being mistaken as assumed length and so rejected.
+!
+! Contributed by Ian Harvey  <ian_harvey@bigpond.com>
+!
+MODULE m
+  IMPLICIT NONE
+  INTERFACE OPERATOR(.ToString.)
+    MODULE PROCEDURE tostring
+  END INTERFACE OPERATOR(.ToString.)
+CONTAINS
+  FUNCTION tostring(arg)
+    INTEGER, INTENT(IN) :: arg
+    CHARACTER(:), ALLOCATABLE :: tostring
+    allocate (character(5) :: tostring)
+    write (tostring, "(I5)") arg
+  END FUNCTION tostring
+END MODULE m
+
+  use m
+  character(:), allocatable :: str
+  integer :: i = 999
+  str = .ToString. i
+  if (str .ne. "  999") call abort
+end
+