Fortran: Fix some of the bugs in associate [PR87477]

2023-04-08  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
	PR fortran/87477
	* iresolve.cc (gfc_resolve_adjustl, gfc_resolve_adjustr): if
	string length is deferred use the string typespec for result.
	* resolve.cc (resolve_assoc_var): Handle parentheses around the
	target expression.
	(resolve_block_construct): Remove unnecessary static decls.
	* trans-array.cc (gfc_conv_expr_descriptor): Guard string len
	expression in condition. Improve handling of string length and
	span, especially for substrings of the descriptor.
	(duplicate_allocatable): Make element type more explicit with
	'eltype'.
	* trans-decl.cc (gfc_get_symbol_decl): Emit a fatal error with
	appropriate message instead of ICE if symbol type is unknown.
	(gfc_generate_function_code): Set current locus to proc_sym
	declared_at.
	* trans-expr.cc (gfc_get_expr_charlen): Retain last charlen in
	'previous' and use if end expression in substring reference is
	null.
	(gfc_conv_string_length): Use gfc_conv_expr_descriptor if
	'expr_flat' is an array. Add post block to catch deallocation
	of temporaries.
	(gfc_conv_procedure_call): Assign the parmse string length to
	the expression string length, if it is deferred.
	(gfc_trans_alloc_subarray_assign): If this is a deferred string
	length component, store the string length in the hidden comp.
	Update the typespec length accordingly. Generate a new type
	spec for the call to gfc_duplicate-allocatable in this case.
	* trans-io.cc (gfc_trans_transfer): Scalarize transfer of
	deferred character array components.

gcc/testsuite/
	PR fortran/87477
	* gfortran.dg/associate_47.f90 : Enable substring test.
	* gfortran.dg/associate_51.f90 : Update an error message.
	* gfortran.dg/goacc/array-with-dt-2.f90 : Add span to
	uninitialzed dg-warnings.

	PR fortran/85686
	PR fortran/88247
	PR fortran/91941
	PR fortran/92779
	PR fortran/93339
	PR fortran/93813
	PR fortran/100948
	PR fortran/102106
	* gfortran.dg/associate_60.f90 : New test

	PR fortran/98408
	* gfortran.dg/pr98408.f90 : New test

	PR fortran/105205
	* gfortran.dg/pr105205.f90 : New test

	PR fortran/106918
	* gfortran.dg/pr106918.f90 : New test

13 files changed, 310 insertions, 41 deletions

diff --git a/gcc/fortran/iresolve.cc b/gcc/fortran/iresolve.cc
index 33794f0..8acad60 100644
--- a/gcc/fortran/iresolve.cc
+++ b/gcc/fortran/iresolve.cc
@@ -230,7 +230,9 @@ gfc_resolve_adjustl (gfc_expr *f, gfc_expr *string)
 {
   f->ts.type = BT_CHARACTER;
   f->ts.kind = string->ts.kind;
-  if (string->ts.u.cl)
+  if (string->ts.deferred)
+    f->ts = string->ts;
+  else if (string->ts.u.cl)
     f->ts.u.cl = gfc_new_charlen (gfc_current_ns, string->ts.u.cl);
 
   f->value.function.name = gfc_get_string ("__adjustl_s%d", f->ts.kind);
@@ -242,7 +244,9 @@ gfc_resolve_adjustr (gfc_expr *f, gfc_expr *string)
 {
   f->ts.type = BT_CHARACTER;
   f->ts.kind = string->ts.kind;
-  if (string->ts.u.cl)
+  if (string->ts.deferred)
+    f->ts = string->ts;
+  else if (string->ts.u.cl)
     f->ts.u.cl = gfc_new_charlen (gfc_current_ns, string->ts.u.cl);
 
   f->value.function.name = gfc_get_string ("__adjustr_s%d", f->ts.kind);
@@ -3361,7 +3365,7 @@ gfc_resolve_mvbits (gfc_code *c)
 }
 
 
-/* Set up the call to RANDOM_INIT.  */ 
+/* Set up the call to RANDOM_INIT.  */
 
 void
 gfc_resolve_random_init (gfc_code *c)
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index f6ec76a..6e42397 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -9084,6 +9084,7 @@ static void
 resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
 {
   gfc_expr* target;
+  bool parentheses = false;
 
   gcc_assert (sym->assoc);
   gcc_assert (sym->attr.flavor == FL_VARIABLE);
@@ -9096,6 +9097,16 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
     return;
   gcc_assert (!sym->assoc->dangling);
 
+  if (target->expr_type == EXPR_OP
+      && target->value.op.op == INTRINSIC_PARENTHESES
+      && target->value.op.op1->expr_type == EXPR_VARIABLE)
+    {
+      sym->assoc->target = gfc_copy_expr (target->value.op.op1);
+      gfc_free_expr (target);
+      target = sym->assoc->target;
+      parentheses = true;
+    }
+
   if (resolve_target && !gfc_resolve_expr (target))
     return;
 
@@ -9177,6 +9188,7 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
 
   /* See if this is a valid association-to-variable.  */
   sym->assoc->variable = (target->expr_type == EXPR_VARIABLE
+			  && !parentheses
 			  && !gfc_has_vector_subscript (target));
 
   /* Finally resolve if this is an array or not.  */
@@ -9191,7 +9203,6 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
       return;
     }
 
-
   /* We cannot deal with class selectors that need temporaries.  */
   if (target->ts.type == BT_CLASS
 	&& gfc_ref_needs_temporary_p (target->ref))
@@ -10885,11 +10896,6 @@ gfc_resolve_forall (gfc_code *code, gfc_namespace *ns, int forall_save)
 
 
 /* Resolve a BLOCK construct statement.  */
-static gfc_expr*
-get_temp_from_expr (gfc_expr *, gfc_namespace *);
-static gfc_code *
-build_assignment (gfc_exec_op, gfc_expr *, gfc_expr *,
-		  gfc_component *, gfc_component *, locus);
 
 static void
 resolve_block_construct (gfc_code* code)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 41661b4..e172580 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -7568,6 +7568,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
   int full;
   bool subref_array_target = false;
   bool deferred_array_component = false;
+  bool substr = false;
   gfc_expr *arg, *ss_expr;
 
   if (se->want_coarray)
@@ -7618,6 +7619,9 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
 	  && TREE_CODE (desc) == COMPONENT_REF)
 	deferred_array_component = true;
 
+      substr = info->ref && info->ref->next
+	       && info->ref->next->type == REF_SUBSTRING;
+
       subref_array_target = (is_subref_array (expr)
 			     && (se->direct_byref
 				 || expr->ts.type == BT_CHARACTER));
@@ -7659,7 +7663,10 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
 				      subref_array_target, expr);
 
 	      /* ....and set the span field.  */
-	      tmp = gfc_conv_descriptor_span_get (desc);
+	      if (ss_info->expr->ts.type == BT_CHARACTER)
+		tmp = gfc_conv_descriptor_span_get (desc);
+	      else
+		tmp = gfc_get_array_span (desc, expr);
 	      gfc_conv_descriptor_span_set (&se->pre, se->expr, tmp);
 	    }
 	  else if (se->want_pointer)
@@ -7730,6 +7737,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
 
 	  need_tmp = 1;
 	  if (expr->ts.type == BT_CHARACTER
+		&& expr->ts.u.cl->length
 		&& expr->ts.u.cl->length->expr_type != EXPR_CONSTANT)
 	    get_array_charlen (expr, se);
 
@@ -7915,7 +7923,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
       /* Set the string_length for a character array.  */
       if (expr->ts.type == BT_CHARACTER)
 	{
-	  if (deferred_array_component)
+	  if (deferred_array_component && !substr)
 	    se->string_length = ss_info->string_length;
 	  else
 	    se->string_length =  gfc_get_expr_charlen (expr);
@@ -7992,7 +8000,11 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
 	}
 
       /* Set the span field.  */
-      tmp = gfc_get_array_span (desc, expr);
+      tmp = NULL_TREE;
+      if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)))
+	tmp = gfc_conv_descriptor_span_get (desc);
+      else
+	tmp = gfc_get_array_span (desc, expr);
       if (tmp)
 	gfc_conv_descriptor_span_set (&loop.pre, parm, tmp);
 
@@ -8766,6 +8778,7 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank,
 		       tree add_when_allocated)
 {
   tree tmp;
+  tree eltype;
   tree size;
   tree nelems;
   tree null_cond;
@@ -8782,10 +8795,11 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank,
       null_data = gfc_finish_block (&block);
 
       gfc_init_block (&block);
+      eltype = TREE_TYPE (type);
       if (str_sz != NULL_TREE)
 	size = str_sz;
       else
-	size = TYPE_SIZE_UNIT (TREE_TYPE (type));
+	size = TYPE_SIZE_UNIT (eltype);
 
       if (!no_malloc)
 	{
@@ -8812,11 +8826,19 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank,
       else
 	nelems = gfc_index_one_node;
 
+      /* If type is not the array type, then it is the element type.  */
+      if (GFC_ARRAY_TYPE_P (type) || GFC_DESCRIPTOR_TYPE_P (type))
+	eltype = gfc_get_element_type (type);
+      else
+	eltype = type;
+
       if (str_sz != NULL_TREE)
 	tmp = fold_convert (gfc_array_index_type, str_sz);
       else
 	tmp = fold_convert (gfc_array_index_type,
-			    TYPE_SIZE_UNIT (gfc_get_element_type (type)));
+			    TYPE_SIZE_UNIT (eltype));
+
+      tmp = gfc_evaluate_now (tmp, &block);
       size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
 			      nelems, tmp);
       if (!no_malloc)
@@ -9865,6 +9887,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest,
 	      /* This component cannot have allocatable components,
 		 therefore add_when_allocated of duplicate_allocatable ()
 		 is always NULL.  */
+	      rank = c->as ? c->as->rank : 0;
 	      tmp = duplicate_allocatable (dcmp, comp, ctype, rank,
 					   false, false, size, NULL_TREE);
 	      gfc_add_expr_to_block (&fnblock, tmp);
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 2573788..299764b 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -1791,6 +1791,9 @@ gfc_get_symbol_decl (gfc_symbol * sym)
       return decl;
     }
 
+  if (sym->ts.type == BT_UNKNOWN)
+    gfc_fatal_error ("%s at %C has no default type", sym->name);
+
   if (sym->attr.intrinsic)
     gfc_internal_error ("intrinsic variable which isn't a procedure");
 
@@ -7538,6 +7541,7 @@ gfc_generate_function_code (gfc_namespace * ns)
     }
 
   trans_function_start (sym);
+  gfc_current_locus = sym->declared_at;
 
   gfc_init_block (&init);
   gfc_init_block (&cleanup);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index d996d29..f052d6b 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -2124,6 +2124,7 @@ gfc_get_expr_charlen (gfc_expr *e)
 {
   gfc_ref *r;
   tree length;
+  tree previous = NULL_TREE;
   gfc_se se;
 
   gcc_assert (e->expr_type == EXPR_VARIABLE
@@ -2149,6 +2150,7 @@ gfc_get_expr_charlen (gfc_expr *e)
   /* Look through the reference chain for component references.  */
   for (r = e->ref; r; r = r->next)
     {
+      previous = length;
       switch (r->type)
 	{
 	case REF_COMPONENT:
@@ -2164,7 +2166,10 @@ gfc_get_expr_charlen (gfc_expr *e)
 	  gfc_init_se (&se, NULL);
 	  gfc_conv_expr_type (&se, r->u.ss.start, gfc_charlen_type_node);
 	  length = se.expr;
-	  gfc_conv_expr_type (&se, r->u.ss.end, gfc_charlen_type_node);
+	  if (r->u.ss.end)
+	    gfc_conv_expr_type (&se, r->u.ss.end, gfc_charlen_type_node);
+	  else
+	    se.expr = previous;
 	  length = fold_build2_loc (input_location, MINUS_EXPR,
 				    gfc_charlen_type_node,
 				    se.expr, length);
@@ -2554,23 +2559,25 @@ gfc_conv_string_length (gfc_charlen * cl, gfc_expr * expr, stmtblock_t * pblock)
       expr_flat = gfc_copy_expr (expr);
       flatten_array_ctors_without_strlen (expr_flat);
       gfc_resolve_expr (expr_flat);
-
-      gfc_conv_expr (&se, expr_flat);
-      gfc_add_block_to_block (pblock, &se.pre);
-      cl->backend_decl = convert (gfc_charlen_type_node, se.string_length);
-
+      if (expr_flat->rank)
+	gfc_conv_expr_descriptor (&se, expr_flat);
+      else
+	gfc_conv_expr (&se, expr_flat);
+      if (expr_flat->expr_type != EXPR_VARIABLE)
+	gfc_add_block_to_block (pblock, &se.pre);
+      se.expr = convert (gfc_charlen_type_node, se.string_length);
+      gfc_add_block_to_block (pblock, &se.post);
       gfc_free_expr (expr_flat);
-      return;
     }
-
-  /* Convert cl->length.  */
-
-  gcc_assert (cl->length);
-
-  gfc_conv_expr_type (&se, cl->length, gfc_charlen_type_node);
-  se.expr = fold_build2_loc (input_location, MAX_EXPR, gfc_charlen_type_node,
-			     se.expr, build_zero_cst (TREE_TYPE (se.expr)));
-  gfc_add_block_to_block (pblock, &se.pre);
+  else
+    {
+      /* Convert cl->length.  */
+      gfc_conv_expr_type (&se, cl->length, gfc_charlen_type_node);
+      se.expr = fold_build2_loc (input_location, MAX_EXPR,
+				 gfc_charlen_type_node, se.expr,
+				 build_zero_cst (TREE_TYPE (se.expr)));
+      gfc_add_block_to_block (pblock, &se.pre);
+    }
 
   if (cl->backend_decl && VAR_P (cl->backend_decl))
     gfc_add_modify (pblock, cl->backend_decl, se.expr);
@@ -7310,10 +7317,13 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
       if (parmse.string_length && fsym && fsym->ts.deferred)
 	{
 	  if (INDIRECT_REF_P (parmse.string_length))
-	    /* In chains of functions/procedure calls the string_length already
-	       is a pointer to the variable holding the length.  Therefore
-	       remove the deref on call.  */
-	    parmse.string_length = TREE_OPERAND (parmse.string_length, 0);
+	    {
+	      /* In chains of functions/procedure calls the string_length already
+		 is a pointer to the variable holding the length.  Therefore
+		 remove the deref on call.  */
+	      tmp = parmse.string_length;
+	      parmse.string_length = TREE_OPERAND (parmse.string_length, 0);
+	    }
 	  else
 	    {
 	      tmp = parmse.string_length;
@@ -7321,6 +7331,17 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		tmp = gfc_evaluate_now (parmse.string_length, &se->pre);
 	      parmse.string_length = gfc_build_addr_expr (NULL_TREE, tmp);
 	    }
+
+	  if (e && e->expr_type == EXPR_VARIABLE
+	      && fsym->attr.allocatable
+	      && e->ts.u.cl->backend_decl
+	      && VAR_P (e->ts.u.cl->backend_decl))
+	    {
+	      if (INDIRECT_REF_P (tmp))
+		tmp = TREE_OPERAND (tmp, 0);
+	      gfc_add_modify (&se->post, e->ts.u.cl->backend_decl,
+			      fold_convert (gfc_charlen_type_node, tmp));
+	    }
 	}
 
       /* Character strings are passed as two parameters, a length and a
@@ -8584,6 +8605,20 @@ gfc_trans_alloc_subarray_assign (tree dest, gfc_component * cm,
   gfc_conv_expr_descriptor (&se, expr);
   gfc_add_block_to_block (&block, &se.pre);
   gfc_add_modify (&block, dest, se.expr);
+  if (cm->ts.type == BT_CHARACTER
+      && gfc_deferred_strlen (cm, &tmp))
+    {
+      tmp = fold_build3_loc (input_location, COMPONENT_REF,
+			     TREE_TYPE (tmp),
+			     TREE_OPERAND (dest, 0),
+			     tmp, NULL_TREE);
+      gfc_add_modify (&block, tmp,
+			      fold_convert (TREE_TYPE (tmp),
+			      se.string_length));
+      cm->ts.u.cl->backend_decl = gfc_create_var (gfc_charlen_type_node,
+						  "slen");
+      gfc_add_modify (&block, cm->ts.u.cl->backend_decl, se.string_length);
+    }
 
   /* Deal with arrays of derived types with allocatable components.  */
   if (gfc_bt_struct (cm->ts.type)
@@ -8607,11 +8642,16 @@ gfc_trans_alloc_subarray_assign (tree dest, gfc_component * cm,
 					   tmp, expr->rank, NULL_TREE);
 	}
     }
+  else if (cm->ts.type == BT_CHARACTER && cm->ts.deferred)
+    tmp = gfc_duplicate_allocatable (dest, se.expr,
+				     gfc_typenode_for_spec (&cm->ts),
+				     cm->as->rank, NULL_TREE);
   else
     tmp = gfc_duplicate_allocatable (dest, se.expr,
 				     TREE_TYPE(cm->backend_decl),
 				     cm->as->rank, NULL_TREE);
 
+
   gfc_add_expr_to_block (&block, tmp);
   gfc_add_block_to_block (&block, &se.post);
 
diff --git a/gcc/fortran/trans-io.cc b/gcc/fortran/trans-io.cc
index baeea95..9b54d2f 100644
--- a/gcc/fortran/trans-io.cc
+++ b/gcc/fortran/trans-io.cc
@@ -2622,10 +2622,10 @@ gfc_trans_transfer (gfc_code * code)
 
       if (expr->ts.type != BT_CLASS
 	 && expr->expr_type == EXPR_VARIABLE
-	 && gfc_expr_attr (expr).pointer)
+	 && ((expr->symtree->n.sym->ts.type == BT_DERIVED && expr->ts.deferred)
+	     || gfc_expr_attr (expr).pointer))
 	goto scalarize;
 
-
       if (!(gfc_bt_struct (expr->ts.type)
 	      || expr->ts.type == BT_CLASS)
 	    && ref && ref->next == NULL
diff --git a/gcc/testsuite/gfortran.dg/associate_47.f90 b/gcc/testsuite/gfortran.dg/associate_47.f90
index 085c6f3..d8a50c6 100644
--- a/gcc/testsuite/gfortran.dg/associate_47.f90
+++ b/gcc/testsuite/gfortran.dg/associate_47.f90
@@ -39,10 +39,9 @@ program p
    end associate
    if (x%d(1) .ne. 'zqrtyd') stop 5
 
-! Substrings of arrays still do not work correctly.
    call foo ('lmnopqrst','ghijklmno')
    associate (y => x%d(:)(2:4))
-!      if (any (y .ne. ['mno','hij'])) stop 6
+      if (any (y .ne. ['mno','hij'])) stop 6
    end associate
 
    call foo ('abcdef','ghijkl')
diff --git a/gcc/testsuite/gfortran.dg/associate_51.f90 b/gcc/testsuite/gfortran.dg/associate_51.f90
index e6f2e4f..2e5218c 100644
--- a/gcc/testsuite/gfortran.dg/associate_51.f90
+++ b/gcc/testsuite/gfortran.dg/associate_51.f90
@@ -51,7 +51,7 @@ recursive subroutine s
 end
 
 recursive subroutine s2
-   associate (y => (s2)) ! { dg-error "Associating selector-expression at .1. yields a procedure" }
+   associate (y => (s2)) ! { dg-error "is a procedure name" }
    end associate
 end
 
diff --git a/gcc/testsuite/gfortran.dg/associate_60.f90 b/gcc/testsuite/gfortran.dg/associate_60.f90
new file mode 100644
index 0000000..d804d62
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_60.f90
@@ -0,0 +1,138 @@
+! { dg-do run }
+!
+! Tests fixes for various pr87477 dependencies
+!
+! Contributed by Gerhard Steinmetz  <gscfq@t-online.de> except for pr102106:
+! which was contributed by Brad Richardson  <everythingfunctional@protonmail.com>
+!
+program associate_60
+  implicit none
+  character(20) :: buffer
+
+  call pr102106
+  call pr100948
+  call pr85686
+  call pr88247
+  call pr91941
+  call pr92779
+  call pr93339
+  call pr93813
+
+contains
+
+  subroutine pr102106
+    type :: sub_class_t
+        integer :: i
+    end type
+    type :: with_polymorphic_component_t
+        class(sub_class_t), allocatable :: sub_obj_
+    end type
+    associate(obj => with_polymorphic_component_t(sub_class_t(42)))
+        if (obj%sub_obj_%i .ne. 42) stop 1
+    end associate
+  end
+
+  subroutine pr100948
+    type t
+      character(:), allocatable :: c(:)
+    end type
+    type(t), allocatable :: x
+!
+! Valid test in comment 1
+!
+    x = t(['ab','cd'])
+    associate (y => x%c(:))
+      if (any (y .ne. x%c)) stop 2
+      if (any (y .ne. ['ab','cd'])) stop 3
+    end associate
+    deallocate (x)
+!
+! Allocation with source was found to only copy over one of the array elements
+!
+    allocate (x, source = t(['ef','gh']))
+    associate (y => x%c(:))
+      if (any (y .ne. x%c)) stop 4
+      if (any (y .ne. ['ef','gh'])) stop 5
+    end associate
+    deallocate (x)
+  end
+
+  subroutine pr85686
+    call s85686([" g'day "," bye!! "])
+    if (trim (buffer) .ne. " a g'day a bye!!") stop 6
+  end
+
+  subroutine s85686(x)
+    character(*) :: x(:)
+    associate (y => 'a'//x)
+      write (buffer, *) y ! Used to segfault at the write statement.
+    end associate
+  end
+
+  subroutine pr88247
+      type t
+         character(:), dimension(:), allocatable :: d
+      end type t
+      type(t), allocatable :: x
+      character(5) :: buffer(3)
+      allocate (x, source = t (['ab','cd'])) ! Didn't work
+      write(buffer(1), *) x%d(2:1:-1)        ! Was found to be broken
+      write(buffer(2), *) [x%d(2:1:-1)]      ! Was OK
+      associate (y => [x%d(2:1:-1)])
+        write(buffer(3), *) y                ! Bug in comment 7
+      end associate
+      if (any (buffer .ne. " cdab")) stop 7
+  end
+
+  subroutine pr91941
+    character(:), allocatable :: x(:), z(:)
+    x = [' abc', ' xyz']
+    z = adjustl(x)
+    associate (y => adjustl(x))              ! Wrong character length was passed
+      if (any(y .ne. ['abc ', 'xyz '])) stop 8
+    end associate
+  end
+
+  subroutine pr92779
+    character(3) :: a = 'abc'
+    associate (y => spread(trim(a),1,2) // 'd')
+      if (any (y .ne. ['abcd','abcd'])) stop 9
+    end associate
+  end
+
+  subroutine pr93339
+    type t
+      character(:), allocatable :: a(:)
+    end type
+    type(t) :: x
+    x = t(["abc "])                    ! Didn't assign anything
+!   allocate (x%a(1), source = 'abc') ! Worked OK
+    associate (y => x%a)
+       if (any (y .ne. 'abc ')) stop 10
+          associate (z => x%a)
+            if (any (y .ne. z)) stop 11
+          end associate
+    end associate
+  end
+
+  subroutine pr93813
+    type t
+    end type
+    type, extends(t) :: t2
+    end type
+    class(t), allocatable :: x
+    integer :: i = 0
+    allocate (t :: x)
+    associate (y => (x))  ! The parentheses triggered an ICE in select type
+      select type (y)
+      type is (t2)
+          stop 12
+      type is (t)
+          i = 42
+      class default
+          stop 13
+      end select
+    end associate
+    if (i .ne. 42) stop 14
+  end
+end
diff --git a/gcc/testsuite/gfortran.dg/goacc/array-with-dt-2.f90 b/gcc/testsuite/gfortran.dg/goacc/array-with-dt-2.f90
index 58f4ce8..560e535 100644
--- a/gcc/testsuite/gfortran.dg/goacc/array-with-dt-2.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/array-with-dt-2.f90
@@ -8,8 +8,9 @@ type(t), allocatable :: b(:)
 ! { dg-note {'b' declared here} {} { target *-*-* } .-1 }
 
 !$acc update host(b(::2))
-! { dg-warning {'b\.dim\[0\]\.ubound' is used uninitialized} {} { target *-*-* } .-1 }
-! { dg-warning {'b\.dim\[0\]\.lbound' is used uninitialized} {} { target *-*-* } .-2 }
+! { dg-warning {'b\.span' is used uninitialized} {} { target *-*-* } .-1 }
+! { dg-warning {'b\.dim\[0\]\.ubound' is used uninitialized} {} { target *-*-* } .-2 }
+! { dg-warning {'b\.dim\[0\]\.lbound' is used uninitialized} {} { target *-*-* } .-3 }
 !$acc update host(b(1)%A(::3,::4))
 end
 
diff --git a/gcc/testsuite/gfortran.dg/pr105205.f90 b/gcc/testsuite/gfortran.dg/pr105205.f90
new file mode 100644
index 0000000..0b6ada6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr105205.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+!
+! Contributed by Rich Townsend  <townsend@astro.wisc.edu>
+!
+program alloc_char_type
+   implicit none
+   integer, parameter :: start = 1, finish = 4
+   character(3) :: check(4)
+   type mytype
+      character(:), allocatable :: c(:)
+   end type mytype
+   type(mytype) :: a
+   type(mytype) :: b
+   integer :: i
+   a%c = ['foo','bar','biz','buz']
+   check = ['foo','bar','biz','buz']
+   b = a
+   do i = 1, size(b%c)
+      if (b%c(i) .ne. check(i)) stop 1
+   end do
+   if (any (a%c .ne. check)) stop 2
+   if (any (a%c(start:finish) .ne. check)) stop 3
+   deallocate (a%c)
+   deallocate (b%c)
+end
diff --git a/gcc/testsuite/gfortran.dg/pr106918.f90 b/gcc/testsuite/gfortran.dg/pr106918.f90
new file mode 100644
index 0000000..25f72b3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr106918.f90
@@ -0,0 +1,19 @@
+! { dg-do run }
+!
+! Contributed by Lionel Guez  <guez@lmd.ens.fr>
+!
+  character(len = :), allocatable:: attr_name(:)
+  character(6) :: buffer
+  type coord_def
+     character(len = :), allocatable:: attr_name(:)
+  end type coord_def
+  type(coord_def) coordinates
+  attr_name = ["units"]
+  write (buffer, *) attr_name
+  if (buffer .ne. " units") stop 1
+  coordinates = coord_def(attr_name)
+  write (buffer, *) coordinates%attr_name
+  if (buffer .ne. " units") stop 2
+  deallocate (attr_name)
+  deallocate (coordinates%attr_name)
+end
diff --git a/gcc/testsuite/gfortran.dg/pr98408.f90 b/gcc/testsuite/gfortran.dg/pr98408.f90
new file mode 100644
index 0000000..4ec1a08
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr98408.f90
@@ -0,0 +1,10 @@
+! { dg-do run }
+!
+! Contributed by Thomas Koenig  <tkoenig@gcc.gnu.org>
+!
+program main
+  character (len=:), allocatable :: a(:)
+  allocate (character(len=10) :: a(5))
+  if (sizeof(a) .ne. 50) stop 1
+  deallocate (a)
+end program main