Correction régression char_length_23.f90

gcc/fortran/trans-array.cc

@@ -6262,6 +6262,7 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
 
   if (expr->ts.type == BT_CHARACTER
       && TREE_CODE (se->string_length) == COMPONENT_REF
+      && expr->ts.u.cl->backend_decl
       && expr->ts.u.cl->backend_decl != se->string_length
       && VAR_P (expr->ts.u.cl->backend_decl))
     gfc_add_modify (&se->pre, expr->ts.u.cl->backend_decl,
@@ -11088,14 +11089,19 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
 	      tmp = tmpse.expr;
 	      expr2->ts.u.cl->backend_decl = gfc_evaluate_now (tmp, &fblock);
 	    }
-	  tmp = fold_convert (TREE_TYPE (expr1->ts.u.cl->backend_decl), tmp);
 	}
 
       if (expr1->ts.u.cl->backend_decl
 	  && VAR_P (expr1->ts.u.cl->backend_decl))
-	gfc_add_modify (&fblock, expr1->ts.u.cl->backend_decl, tmp);
+	{
+	  tmp = fold_convert (TREE_TYPE (expr1->ts.u.cl->backend_decl), tmp);
+	  gfc_add_modify (&fblock, expr1->ts.u.cl->backend_decl, tmp);
+	}
       else
-	gfc_add_modify (&fblock, lss->info->string_length, tmp);
+	{
+	  tmp = fold_convert (TREE_TYPE (lss->info->string_length), tmp);
+	  gfc_add_modify (&fblock, lss->info->string_length, tmp);
+	}
 
       if (expr1->ts.kind > 1)
 	tmp = fold_build2_loc (input_location, MULT_EXPR,

gcc/fortran/trans-descriptor.cc

@@ -2328,12 +2328,11 @@ gfc_set_descriptor (stmtblock_t *block, tree dest, tree src, gfc_expr *src_expr,
     }
   else if (src_expr->rank != -1
 	   && src_expr->ts.type == BT_CHARACTER
-	   && src_expr->ts.deferred
 	   && !element_size_known (dest))
     {
       bool bytes_strides = GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (dest));
       dtype = get_dtype_rank_type_size (src_expr->rank, BT_CHARACTER,
-					bytes_strides, NULL_TREE);
+					bytes_strides, ss->info->string_length);
     }
   else
     dtype = gfc_get_dtype (TREE_TYPE (dest));
@@ -2343,10 +2342,20 @@ gfc_set_descriptor (stmtblock_t *block, tree dest, tree src, gfc_expr *src_expr,
     gfc_conv_descriptor_elem_len_set (block, dest, span);
   else if (src_expr->rank != -1
 	   && src_expr->ts.type == BT_CHARACTER
-	   && src_expr->ts.deferred
+	   && ss->info->string_length == NULL_TREE
 	   && !element_size_known (dest))
     {
-      tree elem_len = gfc_conv_descriptor_elem_len_get (src);
+      tree src_desc = src;
+      if (TREE_CODE (src_desc) == INDIRECT_REF
+	  && DECL_P (TREE_OPERAND (src_desc, 0)))
+	src_desc = TREE_OPERAND (src_desc, 0);
+      if (DECL_P (src_desc)
+	  && DECL_LANG_SPECIFIC (src_desc)
+	  && GFC_DECL_SAVED_DESCRIPTOR (src_desc))
+	src_desc = GFC_DECL_SAVED_DESCRIPTOR (src_desc);
+      if (POINTER_TYPE_P (TREE_TYPE (src_desc)))
+	src_desc = build_fold_indirect_ref_loc (input_location, src_desc);
+      tree elem_len = gfc_conv_descriptor_elem_len_get (src_desc);
       gfc_conv_descriptor_elem_len_set (block, dest, elem_len);
     }
 
@@ -3320,6 +3329,7 @@ gfc_descriptor_init_count (tree descriptor, int rank, int corank,
      it initialized.  */
   if (expr->ts.type == BT_CHARACTER
       && expr->ts.deferred
+      && expr->ts.u.cl->backend_decl
       && VAR_P (expr->ts.u.cl->backend_decl))
     {
       tree dtype;

gcc/fortran/trans-intrinsic.cc

@@ -9903,7 +9903,10 @@ gfc_conv_intrinsic_loc (gfc_se * se, gfc_expr * expr)
       gfc_conv_expr_reference (se, arg_expr);
     }
   else
-    gfc_conv_array_parameter (se, arg_expr, true, NULL, NULL, NULL);
+    {
+      se->bytes_strided = true;
+      gfc_conv_array_parameter (se, arg_expr, true, NULL, NULL, NULL);
+    }
   se->expr = convert (gfc_get_int_type (gfc_index_integer_kind), se->expr);
 
   /* Create a temporary variable for loc return value.  Without this,

gcc/fortran/trans-types.cc

@@ -1401,8 +1401,7 @@ gfc_typenode_for_spec (gfc_typespec * spec, int codim)
       break;
 
     case BT_CHARACTER:
-      basetype = gfc_get_character_type (spec->kind,
+      basetype = gfc_get_character_type (spec->kind, spec->u.cl);
-					 spec->deferred ? nullptr : spec->u.cl);
       break;
 
     case BT_HOLLERITH:
@@ -3056,9 +3055,6 @@ gfc_get_derived_type (gfc_symbol * derived, int codimen)
 	      gfc_conv_const_charlen (c->ts.u.cl);
 	      gcc_assert (c->ts.u.cl->backend_decl);
 	    }
-	  else if (c->ts.type == BT_CHARACTER)
-	    c->ts.u.cl->backend_decl
-			= build_int_cst (gfc_charlen_type_node, 0);
 
 	  field_type = gfc_typenode_for_spec (&c->ts, codimen);
 	}