2014-03-06 Paul Thomas <pault@gcc.gnu.org>

	    Janus Weil  <janus@gcc.gnu.org>

	PR fortran/51976
	* gfortran.h (symbol_attribute): Add deferred_parameter attribute.
	* primary.c (build_actual_constructor): It is not an error if
	a missing component has the deferred_parameter attribute;
	equally, if one is given a value, it is an error.
	* resolve.c (resolve_fl_derived0): Remove error for deferred
	character length components.  Add the hidden string length
	field to the structure. Give it the deferred_parameter
	attribute.
	* trans-array.c (duplicate_allocatable): Add a strlen field
	which is used as the element size if it is non-null.
	(gfc_duplicate_allocatable, gfc_copy_allocatable_data): Pass a
	NULL to the new argument in duplicate_allocatable.
	(structure_alloc_comps): Set the hidden string length as
	appropriate. Use it in calls to duplicate_allocatable.
	(gfc_alloc_allocatable_for_assignment): When a deferred length
	backend declaration is variable, use that; otherwise use the
	string length from the expression evaluation.
	* trans-expr.c (gfc_conv_component_ref): If this is a deferred
	character length component, the string length should have the
	value of the hidden string length field.
	(gfc_trans_subcomponent_assign): Set the hidden string length
	field for deferred character length components.  Allocate the
	necessary memory for the string.
	(alloc_scalar_allocatable_for_assignment): Same change as in
	gfc_alloc_allocatable_for_assignment above.
	* trans-stmt.c (gfc_trans_allocate): Likewise.
	* trans-intrinsic (size_of_string_in_bytes): Make non-static.
	* trans-types.c (gfc_get_derived_type): Set the tree type for
	a deferred character length component.
	* trans.c (gfc_deferred_strlen): New function.
	* trans.h (size_of_string_in_bytes,gfc_deferred_strlen): New prototypes.


2014-03-06  Paul Thomas  <pault@gcc.gnu.org>
	    Janus Weil  <janus@gcc.gnu.org>

	PR fortran/51976
	* gfortran.dg/deferred_type_component_1.f90 : New test.
	* gfortran.dg/deferred_type_component_2.f90 : New test.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@208386 138bc75d-0d04-0410-961f-82ee72b054a4

14 files changed, 329 insertions, 28 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 549421fbafc..f68353a983f 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,39 @@
+2014-03-06  Paul Thomas  <pault@gcc.gnu.org>
+	    Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/51976
+	* gfortran.h (symbol_attribute): Add deferred_parameter attribute.
+	* primary.c (build_actual_constructor): It is not an error if
+	a missing component has the deferred_parameter attribute;
+	equally, if one is given a value, it is an error.
+	* resolve.c (resolve_fl_derived0): Remove error for deferred
+	character length components.  Add the hidden string length
+	field to the structure. Give it the deferred_parameter
+	attribute.
+	* trans-array.c (duplicate_allocatable): Add a strlen field
+	which is used as the element size if it is non-null.
+	(gfc_duplicate_allocatable, gfc_copy_allocatable_data): Pass a
+	NULL to the new argument in duplicate_allocatable.
+	(structure_alloc_comps): Set the hidden string length as
+	appropriate. Use it in calls to duplicate_allocatable.
+	(gfc_alloc_allocatable_for_assignment): When a deferred length
+	backend declaration is variable, use that; otherwise use the
+	string length from the expression evaluation.
+	* trans-expr.c (gfc_conv_component_ref): If this is a deferred
+	character length component, the string length should have the
+	value of the hidden string length field.
+	(gfc_trans_subcomponent_assign): Set the hidden string length
+	field for deferred character length components.  Allocate the
+	necessary memory for the string.
+	(alloc_scalar_allocatable_for_assignment): Same change as in
+	gfc_alloc_allocatable_for_assignment above.
+	* trans-stmt.c (gfc_trans_allocate): Likewise.
+	* trans-intrinsic (size_of_string_in_bytes): Make non-static.
+	* trans-types.c (gfc_get_derived_type): Set the tree type for
+	a deferred character length component.
+	* trans.c (gfc_deferred_strlen): New function.
+	* trans.h (size_of_string_in_bytes,gfc_deferred_strlen): New prototypes.
+
 2014-03-01  Mikael Morin  <mikael@gcc.gnu.org>
 
 	PR fortran/60341
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 197798c3922..cd2a91323a3 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -811,6 +811,9 @@ typedef struct
   /* Attributes set by compiler extensions (!GCC$ ATTRIBUTES).  */
   unsigned ext_attr:EXT_ATTR_NUM;
 
+  /* Is a parameter associated with a deferred type component.  */
+  unsigned deferred_parameter:1;
+
   /* The namespace where the attribute has been set.  */
   struct gfc_namespace *volatile_ns, *asynchronous_ns;
 }
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 7d7fbadf2f0..e2eb46748fe 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -2355,7 +2355,7 @@ build_actual_constructor (gfc_structure_ctor_component **comp_head,
 	}
 
       /* If it was not found, try the default initializer if there's any;
-	 otherwise, it's an error.  */
+	 otherwise, it's an error unless this is a deferred parameter.  */
       if (!comp_iter)
 	{
 	  if (comp->initializer)
@@ -2365,7 +2365,7 @@ build_actual_constructor (gfc_structure_ctor_component **comp_head,
 		return false;
 	      value = gfc_copy_expr (comp->initializer);
 	    }
-	  else
+	  else if (!comp->attr.deferred_parameter)
 	    {
 	      gfc_error ("No initializer for component '%s' given in the"
 			 " structure constructor at %C!", comp->name);
@@ -2447,7 +2447,7 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c
 	{
 	  /* Components without name are not allowed after the first named
 	     component initializer!  */
-	  if (!comp)
+	  if (!comp || comp->attr.deferred_parameter)
 	    {
 	      if (last_name)
 		gfc_error ("Component initializer without name after component"
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 8d5ca1be507..bcdfcadd3d1 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -12105,14 +12105,6 @@ resolve_fl_derived0 (gfc_symbol *sym)
       if (c->attr.artificial)
 	continue;
 
-      /* See PRs 51550, 47545, 48654, 49050, 51075 - and 45170.  */
-      if (c->ts.type == BT_CHARACTER && c->ts.deferred && !c->attr.function)
-	{
-	  gfc_error ("Deferred-length character component '%s' at %L is not "
-		     "yet supported", c->name, &c->loc);
-	  return false;
-	}
-
       /* F2008, C442.  */
       if ((!sym->attr.is_class || c != sym->components)
 	  && c->attr.codimension
@@ -12364,6 +12356,25 @@ resolve_fl_derived0 (gfc_symbol *sym)
 	  return false;
 	}
 
+      /* Add the hidden deferred length field.  */
+      if (c->ts.type == BT_CHARACTER && c->ts.deferred && !c->attr.function
+	  && !sym->attr.is_class)
+	{
+	  char name[GFC_MAX_SYMBOL_LEN+9];
+	  gfc_component *strlen;
+	  sprintf (name, "_%s_length", c->name);
+	  strlen = gfc_find_component (sym, name, true, true);
+	  if (strlen == NULL)
+	    {
+	      if (!gfc_add_component (sym, name, &strlen))
+		return false;
+	      strlen->ts.type = BT_INTEGER;
+	      strlen->ts.kind = gfc_charlen_int_kind;
+	      strlen->attr.access = ACCESS_PRIVATE;
+	      strlen->attr.deferred_parameter = 1;
+	    }
+	}
+
       if (c->ts.type == BT_DERIVED
 	  && sym->component_access != ACCESS_PRIVATE
 	  && gfc_check_symbol_access (sym)
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 8e7b75ed601..153ef67e49e 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -7365,7 +7365,7 @@ get_full_array_size (stmtblock_t *block, tree decl, int rank)
 
 static tree
 duplicate_allocatable (tree dest, tree src, tree type, int rank,
-		       bool no_malloc)
+		       bool no_malloc, tree str_sz)
 {
   tree tmp;
   tree size;
@@ -7386,7 +7386,11 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank,
       null_data = gfc_finish_block (&block);
 
       gfc_init_block (&block);
-      size = TYPE_SIZE_UNIT (TREE_TYPE (type));
+      if (str_sz != NULL_TREE)
+	size = str_sz;
+      else
+	size = TYPE_SIZE_UNIT (TREE_TYPE (type));
+
       if (!no_malloc)
 	{
 	  tmp = gfc_call_malloc (&block, type, size);
@@ -7410,8 +7414,11 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank,
       else
 	nelems = gfc_index_one_node;
 
-      tmp = fold_convert (gfc_array_index_type,
-			  TYPE_SIZE_UNIT (gfc_get_element_type (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)));
       size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
 			      nelems, tmp);
       if (!no_malloc)
@@ -7452,7 +7459,7 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank,
 tree
 gfc_duplicate_allocatable (tree dest, tree src, tree type, int rank)
 {
-  return duplicate_allocatable (dest, src, type, rank, false);
+  return duplicate_allocatable (dest, src, type, rank, false, NULL_TREE);
 }
 
 
@@ -7461,7 +7468,7 @@ gfc_duplicate_allocatable (tree dest, tree src, tree type, int rank)
 tree
 gfc_copy_allocatable_data (tree dest, tree src, tree type, int rank)
 {
-  return duplicate_allocatable (dest, src, type, rank, true);
+  return duplicate_allocatable (dest, src, type, rank, true, NULL_TREE);
 }
 
 
@@ -7718,6 +7725,16 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
 				     void_type_node, comp,
 				     build_int_cst (TREE_TYPE (comp), 0));
 	      gfc_add_expr_to_block (&fnblock, tmp);
+	      if (gfc_deferred_strlen (c, &comp))
+		{
+		  comp = fold_build3_loc (input_location, COMPONENT_REF,
+					  TREE_TYPE (comp),
+					  decl, comp, NULL_TREE);
+		  tmp = fold_build2_loc (input_location, MODIFY_EXPR,
+					 TREE_TYPE (comp), comp,
+					 build_int_cst (TREE_TYPE (comp), 0));
+		  gfc_add_expr_to_block (&fnblock, tmp);
+		}
 	    }
 	  else if (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.allocatable)
 	    {
@@ -7855,8 +7872,26 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
 	      continue;
 	    }
 
-	  if (c->attr.allocatable && !c->attr.proc_pointer
-	      && !cmp_has_alloc_comps)
+	  if (gfc_deferred_strlen (c, &tmp))
+	    {
+	      tree len, size;
+	      len = tmp;
+	      tmp = fold_build3_loc (input_location, COMPONENT_REF,
+				     TREE_TYPE (len),
+				     decl, len, NULL_TREE);
+	      len = fold_build3_loc (input_location, COMPONENT_REF,
+				     TREE_TYPE (len),
+				     dest, len, NULL_TREE);
+	      tmp = fold_build2_loc (input_location, MODIFY_EXPR,
+				     TREE_TYPE (len), len, tmp);
+	      gfc_add_expr_to_block (&fnblock, tmp);
+	      size = size_of_string_in_bytes (c->ts.kind, len);
+	      tmp = duplicate_allocatable (dcmp, comp, ctype, rank,
+					   false, size);
+	      gfc_add_expr_to_block (&fnblock, tmp);
+	    }
+	  else if (c->attr.allocatable && !c->attr.proc_pointer
+		   && !cmp_has_alloc_comps)
 	    {
 	      rank = c->as ? c->as->rank : 0;
 	      if (c->attr.codimension)
@@ -8342,10 +8377,24 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
   /* Get the new lhs size in bytes.  */
   if (expr1->ts.type == BT_CHARACTER && expr1->ts.deferred)
     {
-      tmp = expr2->ts.u.cl->backend_decl;
-      gcc_assert (expr1->ts.u.cl->backend_decl);
-      tmp = fold_convert (TREE_TYPE (expr1->ts.u.cl->backend_decl), tmp);
-      gfc_add_modify (&fblock, expr1->ts.u.cl->backend_decl, tmp);
+      if (expr2->ts.deferred)
+	{
+	  if (TREE_CODE (expr2->ts.u.cl->backend_decl) == VAR_DECL)
+	    tmp = expr2->ts.u.cl->backend_decl;
+	  else
+	    tmp = rss->info->string_length;
+	}
+      else
+	{
+	  tmp = expr2->ts.u.cl->backend_decl;
+	  tmp = fold_convert (TREE_TYPE (expr1->ts.u.cl->backend_decl), tmp);
+	}
+
+      if (expr1->ts.u.cl->backend_decl
+	  && TREE_CODE (expr1->ts.u.cl->backend_decl) == VAR_DECL)
+	gfc_add_modify (&fblock, expr1->ts.u.cl->backend_decl, tmp);
+      else
+	gfc_add_modify (&fblock, lss->info->string_length, tmp);
     }
   else if (expr1->ts.type == BT_CHARACTER && expr1->ts.u.cl->backend_decl)
     {
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 297ff679883..269fcc5c86c 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1689,6 +1689,14 @@ gfc_conv_component_ref (gfc_se * se, gfc_ref * ref)
       se->string_length = tmp;
     }
 
+  if (gfc_deferred_strlen (c, &field))
+    {
+      tmp = fold_build3_loc (input_location, COMPONENT_REF,
+			     TREE_TYPE (field),
+			     decl, field, NULL_TREE);
+      se->string_length = tmp;
+    }
+
   if (((c->attr.pointer || c->attr.allocatable)
        && (!c->attr.dimension && !c->attr.codimension)
        && c->ts.type != BT_CHARACTER)
@@ -6043,9 +6051,42 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr)
 	  gfc_add_expr_to_block (&block, tmp);
 	}
     }
-  else
+  else if (gfc_deferred_strlen (cm, &tmp))
+    {
+      tree strlen;
+      strlen = tmp;
+      gcc_assert (strlen);
+      strlen = fold_build3_loc (input_location, COMPONENT_REF,
+				TREE_TYPE (strlen),
+				TREE_OPERAND (dest, 0),
+				strlen, NULL_TREE);
+
+      if (expr->expr_type == EXPR_NULL)
+	{
+	  tmp = build_int_cst (TREE_TYPE (cm->backend_decl), 0);
+	  gfc_add_modify (&block, dest, tmp);
+	  tmp = build_int_cst (TREE_TYPE (strlen), 0);
+	  gfc_add_modify (&block, strlen, tmp);
+	}
+      else
+	{
+	  tree size;
+	  gfc_init_se (&se, NULL);
+	  gfc_conv_expr (&se, expr);
+	  size = size_of_string_in_bytes (cm->ts.kind, se.string_length);
+	  tmp = build_call_expr_loc (input_location,
+				     builtin_decl_explicit (BUILT_IN_MALLOC),
+				     1, size);
+	  gfc_add_modify (&block, dest,
+			  fold_convert (TREE_TYPE (dest), tmp));
+	  gfc_add_modify (&block, strlen, se.string_length);
+	  tmp = gfc_build_memcpy_call (dest, se.expr, size);
+	  gfc_add_expr_to_block (&block, tmp);
+	}
+    }
+  else if (!cm->attr.deferred_parameter)
     {
-      /* Scalar component.  */
+      /* Scalar component (excluding deferred parameters).  */
       gfc_init_se (&se, NULL);
       gfc_init_se (&lse, NULL);
 
@@ -7747,7 +7788,10 @@ alloc_scalar_allocatable_for_assignment (stmtblock_t *block,
 
       /* Update the lhs character length.  */
       size = string_length;
-      gfc_add_modify (block, expr1->ts.u.cl->backend_decl, size);
+      if (TREE_CODE (expr1->ts.u.cl->backend_decl) == VAR_DECL)
+	gfc_add_modify (block, expr1->ts.u.cl->backend_decl, size);
+      else
+	gfc_add_modify (block, lse.string_length, size);
     }
 }
 
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index cff8e89507f..75bd20ae04a 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -5166,7 +5166,7 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr)
    excluding the terminating null characters.  The result has
    gfc_array_index_type type.  */
 
-static tree
+tree
 size_of_string_in_bytes (int kind, tree string_length)
 {
   tree bytesize;
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 19e29a74bce..c7ff7a8cb8e 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -5028,6 +5028,11 @@ gfc_trans_allocate (gfc_code * code)
 	      if (tmp && TREE_CODE (tmp) == VAR_DECL)
 		gfc_add_modify (&se.pre, tmp, fold_convert (TREE_TYPE (tmp),
 				memsz));
+	      else if (al->expr->ts.type == BT_CHARACTER
+		       && al->expr->ts.deferred && se.string_length)
+		gfc_add_modify (&se.pre, se.string_length,
+				fold_convert (TREE_TYPE (se.string_length),
+				memsz));
 
 	      /* Convert to size in bytes, using the character KIND.  */
 	      if (unlimited_char)
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index adc34ddfa9d..be268cfbdec 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -2486,12 +2486,15 @@ gfc_get_derived_type (gfc_symbol * derived)
         field_type = c->ts.u.derived->backend_decl;
       else
 	{
-	  if (c->ts.type == BT_CHARACTER)
+	  if (c->ts.type == BT_CHARACTER && !c->ts.deferred)
 	    {
 	      /* Evaluate the string length.  */
 	      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);
 	}
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index c5b3b9e40e1..073e34f0eb5 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -2044,3 +2044,21 @@ gfc_likely (tree cond)
   cond = fold_convert (boolean_type_node, cond);
   return cond;
 }
+
+
+/* Get the string length for a deferred character length component.  */
+
+bool
+gfc_deferred_strlen (gfc_component *c, tree *decl)
+{
+  char name[GFC_MAX_SYMBOL_LEN+9];
+  gfc_component *strlen;
+  if (!(c->ts.type == BT_CHARACTER && c->ts.deferred))
+    return false;
+  sprintf (name, "_%s_length", c->name);
+  for (strlen = c; strlen; strlen = strlen->next)
+    if (strcmp (strlen->name, name) == 0)
+      break;
+  *decl = strlen ? strlen->backend_decl : NULL_TREE;
+  return strlen != NULL;
+}
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index e05a375bf49..5fb0cbf2289 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -422,6 +422,8 @@ tree gfc_evaluate_now (tree, stmtblock_t *);
 /* Find the appropriate variant of a math intrinsic.  */
 tree gfc_builtin_decl_for_float_kind (enum built_in_function, int);
 
+tree size_of_string_in_bytes (int, tree);
+
 /* Intrinsic procedure handling.  */
 tree gfc_conv_intrinsic_subroutine (gfc_code *);
 void gfc_conv_intrinsic_function (gfc_se *, gfc_expr *);
@@ -581,6 +583,9 @@ bool get_array_ctor_strlen (stmtblock_t *, gfc_constructor_base, tree *);
 tree gfc_likely (tree);
 tree gfc_unlikely (tree);
 
+/* Return the string length of a deferred character length component.  */
+bool gfc_deferred_strlen (gfc_component *, tree *);
+
 /* Generate a runtime error call.  */
 tree gfc_trans_runtime_error (bool, locus*, const char*, ...);
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 779fa96a737..fe4a19b86dc 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2014-03-06  Paul Thomas  <pault@gcc.gnu.org>
+	    Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/51976
+	* gfortran.dg/deferred_type_component_1.f90 : New test.
+	* gfortran.dg/deferred_type_component_2.f90 : New test.
+
 2014-03-06  Marek Polacek  <polacek@redhat.com>
 
 	PR c/60197
diff --git a/gcc/testsuite/gfortran.dg/deferred_type_component_1.f90 b/gcc/testsuite/gfortran.dg/deferred_type_component_1.f90
new file mode 100644
index 00000000000..a7826d9bdea
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/deferred_type_component_1.f90
@@ -0,0 +1,60 @@
+! { dg-do run }
+!
+! PR 51976: [F2003] Support deferred-length character components of derived types (allocatable string length)
+!
+! Contributed by Tobias Burnus  <burnus@gcc.gnu.org>
+
+  type t
+    character(len=:), allocatable :: str_comp
+    character(len=:), allocatable :: str_comp1
+  end type t
+  type(t) :: x
+  type(t), allocatable, dimension(:) :: array
+
+  ! Check scalars
+  allocate (x%str_comp, source = "abc")
+  call check (x%str_comp, "abc")
+  deallocate (x%str_comp)
+  allocate (x%str_comp, source = "abcdefghijklmnop")
+  call check (x%str_comp, "abcdefghijklmnop")
+  x%str_comp = "xyz"
+  call check (x%str_comp, "xyz")
+  x%str_comp = "abcdefghijklmnop"
+  x%str_comp1 = "lmnopqrst"
+  call foo (x%str_comp1, "lmnopqrst")
+  call bar (x, "abcdefghijklmnop", "lmnopqrst")
+
+  ! Check arrays and structure constructors
+  allocate (array(2), source = [t("abcedefg","hi"), t("jkl","mnop")])
+  call check (array(1)%str_comp, "abcedefg")
+  call check (array(1)%str_comp1, "hi")
+  call check (array(2)%str_comp, "jkl")
+  call check (array(2)%str_comp1, "mnop")
+  deallocate (array)
+  allocate (array(3), source = [x, x, x])
+  array(2)%str_comp = "blooey"
+  call bar (array(1), "abcdefghijklmnop", "lmnopqrst")
+  call bar (array(2), "blooey", "lmnopqrst")
+  call bar (array(3), "abcdefghijklmnop", "lmnopqrst")
+
+contains
+
+  subroutine foo (chr1, chr2)
+    character (*) :: chr1, chr2
+    call check (chr1, chr2)
+  end subroutine
+
+  subroutine bar (a, chr1, chr2)
+    character (*) :: chr1, chr2
+    type(t) :: a
+    call check (a%str_comp, chr1)
+    call check (a%str_comp1, chr2)
+  end subroutine
+
+  subroutine check (chr1, chr2)
+    character (*) :: chr1, chr2
+    if (len(chr1) .ne. len (chr2)) call abort
+    if (chr1 .ne. chr2) call abort
+  end subroutine
+
+end
diff --git a/gcc/testsuite/gfortran.dg/deferred_type_component_2.f90 b/gcc/testsuite/gfortran.dg/deferred_type_component_2.f90
new file mode 100644
index 00000000000..63e7fa39301
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/deferred_type_component_2.f90
@@ -0,0 +1,60 @@
+! { dg-do run }
+!
+! PR 51976: [F2003] Support deferred-length character components of derived types (allocatable string length)
+!
+! Contributed by Tobias Burnus  <burnus@gcc.gnu.org>
+
+  type t
+    character(len=:,kind=4), allocatable :: str_comp
+    character(len=:,kind=4), allocatable :: str_comp1
+  end type t
+  type(t) :: x
+  type(t), allocatable, dimension(:) :: array
+
+  ! Check scalars
+  allocate (x%str_comp, source = 4_"abc")
+  call check (x%str_comp, 4_"abc")
+  deallocate (x%str_comp)
+  allocate (x%str_comp, source = 4_"abcdefghijklmnop")
+  call check (x%str_comp, 4_"abcdefghijklmnop")
+  x%str_comp = 4_"xyz"
+  call check (x%str_comp, 4_"xyz")
+  x%str_comp = 4_"abcdefghijklmnop"
+  x%str_comp1 = 4_"lmnopqrst"
+  call foo (x%str_comp1, 4_"lmnopqrst")
+  call bar (x, 4_"abcdefghijklmnop", 4_"lmnopqrst")
+
+  ! Check arrays and structure constructors
+  allocate (array(2), source = [t(4_"abcedefg",4_"hi"), t(4_"jkl",4_"mnop")])
+  call check (array(1)%str_comp, 4_"abcedefg")
+  call check (array(1)%str_comp1, 4_"hi")
+  call check (array(2)%str_comp, 4_"jkl")
+  call check (array(2)%str_comp1, 4_"mnop")
+  deallocate (array)
+  allocate (array(3), source = [x, x, x])
+  array(2)%str_comp = 4_"blooey"
+  call bar (array(1), 4_"abcdefghijklmnop", 4_"lmnopqrst")
+  call bar (array(2), 4_"blooey", 4_"lmnopqrst")
+  call bar (array(3), 4_"abcdefghijklmnop", 4_"lmnopqrst")
+
+contains
+
+  subroutine foo (chr1, chr2)
+    character (len=*,kind=4) :: chr1, chr2
+    call check (chr1, chr2)
+  end subroutine
+
+  subroutine bar (a, chr1, chr2)
+    character (len=*,kind=4) :: chr1, chr2
+    type(t) :: a
+    call check (a%str_comp, chr1)
+    call check (a%str_comp1, chr2)
+  end subroutine
+
+  subroutine check (chr1, chr2)
+    character (len=*,kind=4) :: chr1, chr2
+    if (len(chr1) .ne. len (chr2)) call abort
+    if (chr1 .ne. chr2) call abort
+  end subroutine
+
+end