Index: gcc/fortran/gfortran.h
===================================================================
*** gcc/fortran/gfortran.h	(revision 196244)
--- gcc/fortran/gfortran.h	(working copy)
*************** typedef struct
*** 810,815 ****
--- 810,818 ----
    /* 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;
  }
Index: gcc/fortran/primary.c
===================================================================
*** gcc/fortran/primary.c	(revision 196244)
--- gcc/fortran/primary.c	(working copy)
*************** build_actual_constructor (gfc_structure_
*** 2349,2355 ****
  	}
  
        /* If it was not found, try the default initializer if there's any;
! 	 otherwise, it's an error.  */
        if (!comp_iter)
  	{
  	  if (comp->initializer)
--- 2349,2355 ----
  	}
  
        /* If it was not found, try the default initializer if there's any;
! 	 otherwise, it's an error unless this is a deferred parameter.  */
        if (!comp_iter)
  	{
  	  if (comp->initializer)
*************** build_actual_constructor (gfc_structure_
*** 2360,2366 ****
  		return FAILURE;
  	      value = gfc_copy_expr (comp->initializer);
  	    }
! 	  else
  	    {
  	      gfc_error ("No initializer for component '%s' given in the"
  			 " structure constructor at %C!", comp->name);
--- 2360,2366 ----
  		return FAILURE;
  	      value = gfc_copy_expr (comp->initializer);
  	    }
! 	  else if (!comp->attr.deferred_parameter)
  	    {
  	      gfc_error ("No initializer for component '%s' given in the"
  			 " structure constructor at %C!", comp->name);
*************** gfc_convert_to_structure_constructor (gf
*** 2443,2449 ****
  	{
  	  /* Components without name are not allowed after the first named
  	     component initializer!  */
! 	  if (!comp)
  	    {
  	      if (last_name)
  		gfc_error ("Component initializer without name after component"
--- 2443,2449 ----
  	{
  	  /* Components without name are not allowed after the first named
  	     component initializer!  */
! 	  if (!comp || comp->attr.deferred_parameter)
  	    {
  	      if (last_name)
  		gfc_error ("Component initializer without name after component"
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c	(revision 196244)
--- gcc/fortran/resolve.c	(working copy)
*************** resolve_fl_derived0 (gfc_symbol *sym)
*** 12540,12553 ****
        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 FAILURE;
- 	}
- 
        /* F2008, C442.  */
        if ((!sym->attr.is_class || c != sym->components)
  	  && c->attr.codimension
--- 12540,12545 ----
*************** resolve_fl_derived0 (gfc_symbol *sym)
*** 12799,12804 ****
--- 12791,12815 ----
  	  return FAILURE;
  	}
  
+       /* 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+1];
+ 	  gfc_component *strlen;
+ 	  sprintf (name, "_%s", c->name);
+ 	  strlen = gfc_find_component (sym, name, true, true);
+ 	  if (strlen == NULL)
+ 	    {
+ 	      if (gfc_add_component (sym, name, &strlen) == FAILURE)
+ 		return FAILURE;
+ 	      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)
Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c	(revision 196244)
--- gcc/fortran/trans-array.c	(working copy)
*************** get_full_array_size (stmtblock_t *block,
*** 7308,7314 ****
  
  static tree
  duplicate_allocatable (tree dest, tree src, tree type, int rank,
! 		       bool no_malloc)
  {
    tree tmp;
    tree size;
--- 7308,7314 ----
  
  static tree
  duplicate_allocatable (tree dest, tree src, tree type, int rank,
! 		       bool no_malloc, tree strlen)
  {
    tree tmp;
    tree size;
*************** duplicate_allocatable (tree dest, tree s
*** 7329,7334 ****
--- 7329,7337 ----
        null_data = gfc_finish_block (&block);
  
        gfc_init_block (&block);
+       if (strlen != NULL_TREE)
+ 	size = strlen;
+       else
  	size = TYPE_SIZE_UNIT (TREE_TYPE (type));
        if (!no_malloc)
  	{
*************** duplicate_allocatable (tree dest, tree s
*** 7349,7354 ****
--- 7352,7360 ----
  
        gfc_init_block (&block);
        nelems = get_full_array_size (&block, src, rank);
+       if (strlen != NULL_TREE)
+ 	tmp = fold_convert (gfc_array_index_type, strlen);
+       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,
*************** duplicate_allocatable (tree dest, tree s
*** 7391,7397 ****
  tree
  gfc_duplicate_allocatable (tree dest, tree src, tree type, int rank)
  {
!   return duplicate_allocatable (dest, src, type, rank, false);
  }
  
  
--- 7397,7403 ----
  tree
  gfc_duplicate_allocatable (tree dest, tree src, tree type, int rank)
  {
!   return duplicate_allocatable (dest, src, type, rank, false, NULL_TREE);
  }
  
  
*************** gfc_duplicate_allocatable (tree dest, tr
*** 7400,7406 ****
  tree
  gfc_copy_allocatable_data (tree dest, tree src, tree type, int rank)
  {
!   return duplicate_allocatable (dest, src, type, rank, true);
  }
  
  
--- 7406,7412 ----
  tree
  gfc_copy_allocatable_data (tree dest, tree src, tree type, int rank)
  {
!   return duplicate_allocatable (dest, src, type, rank, true, NULL_TREE);
  }
  
  
*************** structure_alloc_comps (gfc_symbol * der_
*** 7637,7642 ****
--- 7643,7658 ----
  				     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)
  	    {
*************** structure_alloc_comps (gfc_symbol * der_
*** 7730,7736 ****
  	      continue;
  	    }
  
! 	  if (c->attr.allocatable && !c->attr.proc_pointer
  	      && !cmp_has_alloc_comps)
  	    {
  	      rank = c->as ? c->as->rank : 0;
--- 7746,7769 ----
  	      continue;
  	    }
  
! 	  if (gfc_deferred_strlen (c, &tmp))
! 	    {
! 	      tree len;
! 	      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);
! 	      tmp = duplicate_allocatable (dcmp, comp, ctype, rank,
! 					   false, len);
! 	      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;
*************** gfc_alloc_allocatable_for_assignment (gf
*** 8183,8192 ****
    /* 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);
      }
    else if (expr1->ts.type == BT_CHARACTER && expr1->ts.u.cl->backend_decl)
      {
--- 8216,8239 ----
    /* Get the new lhs size in bytes.  */
    if (expr1->ts.type == BT_CHARACTER && expr1->ts.deferred)
      {
+       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)
      {
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c	(revision 196244)
--- gcc/fortran/trans-expr.c	(working copy)
*************** gfc_conv_component_ref (gfc_se * se, gfc
*** 1589,1594 ****
--- 1589,1602 ----
        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)
*************** gfc_trans_subcomponent_assign (tree dest
*** 6031,6039 ****
  	  gfc_add_expr_to_block (&block, tmp);
  	}
      }
    else
      {
!       /* Scalar component.  */
        gfc_init_se (&se, NULL);
        gfc_init_se (&lse, NULL);
  
--- 6039,6078 ----
  	  gfc_add_expr_to_block (&block, tmp);
  	}
      }
+   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
    	{
! 	  gfc_init_se (&se, NULL);
! 	  gfc_conv_expr (&se, expr);
! 	  tmp = build_call_expr_loc (input_location,
! 				     builtin_decl_explicit (BUILT_IN_MALLOC),
! 				     1, se.string_length);
! 	  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, se.string_length);
! 	  gfc_add_expr_to_block (&block, tmp);
! 	}
!     }
!   else if (!cm->attr.deferred_parameter)
!     {
!       /* Scalar component (excluding deferred parameters).  */
        gfc_init_se (&se, NULL);
        gfc_init_se (&lse, NULL);
  
*************** alloc_scalar_allocatable_for_assignment
*** 7629,7635 ****
--- 7668,7677 ----
  
        /* Update the lhs character length.  */
        size = string_length;
+       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);
      }
  }
  
Index: gcc/fortran/trans-stmt.c
===================================================================
*** gcc/fortran/trans-stmt.c	(revision 196244)
--- gcc/fortran/trans-stmt.c	(working copy)
*************** gfc_trans_allocate (gfc_code * code)
*** 5009,5014 ****
--- 5009,5019 ----
  	      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)
Index: gcc/fortran/trans-types.c
===================================================================
*** gcc/fortran/trans-types.c	(revision 196244)
--- gcc/fortran/trans-types.c	(working copy)
*************** gfc_get_derived_type (gfc_symbol * deriv
*** 2482,2493 ****
          field_type = c->ts.u.derived->backend_decl;
        else
  	{
! 	  if (c->ts.type == BT_CHARACTER)
  	    {
  	      /* Evaluate the string length.  */
  	      gfc_conv_const_charlen (c->ts.u.cl);
  	      gcc_assert (c->ts.u.cl->backend_decl);
  	    }
  
  	  field_type = gfc_typenode_for_spec (&c->ts);
  	}
--- 2482,2496 ----
          field_type = c->ts.u.derived->backend_decl;
        else
  	{
! 	  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);
  	}
Index: gcc/fortran/trans.c
===================================================================
*** gcc/fortran/trans.c	(revision 196244)
--- gcc/fortran/trans.c	(working copy)
*************** gfc_likely (tree cond)
*** 1843,1845 ****
--- 1843,1864 ----
    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+1];
+   gfc_component *strlen;
+   if (!(c->ts.type == BT_CHARACTER && c->ts.deferred))
+     return false;
+   sprintf (name, "_%s", 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;
+ }
+ 
Index: gcc/fortran/trans.h
===================================================================
*** gcc/fortran/trans.h	(revision 196244)
--- gcc/fortran/trans.h	(working copy)
*************** bool get_array_ctor_strlen (stmtblock_t
*** 578,583 ****
--- 578,586 ----
  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*, ...);
  
Index: gcc/testsuite/gfortran.dg/deferred_type_component_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/deferred_type_component_1.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/deferred_type_component_1.f90	(working copy)
***************
*** 0 ****
--- 1,54 ----
+ ! { dg-do run }
+ ! Test fix for PR51976 - introduce deferred character length components
+ !
+ ! 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
