[Patch, fortran] PR51976 - [F2003] Support deferred-length character components of derived types (allocatable string length)

[Patch, fortran] PR51976 - [F2003] Support deferred-length character components of derived types (allocatable string length)

[Paul Richard Thomas]

[-- Attachment #1: Type: text/plain, Size: 2606 bytes --]

Dear All,

The attached patch represents progress to date.  It fixes the original
problem in this PR and allows John Reid's version of
iso_varying_string/vocabulary_word_count.f90 to compile and run
correctly.  It even bootstraps and regtests!

However, it doe not fix:
PR51976 comment #6 and PR51550 - allocate with typespec ICEs
PR51976 comment #6 FORALL assignment is messed up and ICEs..
PR47545 the compiler complains about the lack of an initializer for
the hidden character length field.
PR45170 will need going through from one end to the other - there is a
lot of "stuff" here!

Of these, I consider the fix of the PR47545 problem to be a must and
the allocate with typespec desirable.

Cheers

Paul

2013-02-24  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/51976
    * gfortran.h : 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-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 : Prototype for the new function.

2013-02-24  Paul Thomas  <pault@gcc.gnu.org>

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

[-- Attachment #2: submit.diff --]
[-- Type: application/octet-stream, Size: 17268 bytes --]

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

Re: [Patch, fortran] PR51976 - [F2003] Support deferred-length character components of derived types (allocatable string length)

[Tobias Burnus]

Paul Richard Thomas wrote:
> The attached patch represents progress to date.  It fixes the original
> problem in this PR and allows John Reid's version of
> iso_varying_string/vocabulary_word_count.f90 to compile and run
> correctly.  It even bootstraps and regtests!

Great! It seems as if 4.9 will get a much-wished feature soon after 4.8 
is branched.

> +   /* Is a parameter associated with a deferred type component.  */
> +   unsigned deferred_parameter:1;

I quickly glanced at the patch and I am still not sure what 
"deferred_parameter" is exactly doing nor what "parameter" means in this 
context. I know a named constant ("PARAMETER") and (kind/length) type 
parameters of intrinsic types and (via "kind" and "len") derived types. 
Can you make it a bit clearer what this attribute is good for? – Do you 
need to handle it in module.c or in dump-parse-tree.c?

(A while later)

Looking at the patch a bit more carefully, "deferred_parameter" seems to 
be set for the hidden length component to a deferred-length character 
component. I think it is not really a (type) parameter; maybe 
"deferred_length_comp"?


>          /* 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.  */

"a hidden deferred-length component"?

> +       /* Add the hidden deferred length field.  */

Or "field" ;-)


Otherwise, it looks okay to me – but I have not yet fully studied the 
patch nor applied and tried to break it ;-)
For instance, trying "select type(comp%str); case (character(len=*); 
print *, len(comp%str)" where "str" is "class(*)".

Tobias

Re: [Patch, fortran] PR51976 - [F2003] Support deferred-length character components of derived types (allocatable string length)

[Tobias Burnus]

[-- Attachment #1: Type: text/plain, Size: 1485 bytes --]

Dear Paul, dear all,

On February 24, 2013 Paul Richard Thomas wrote:
> The attached patch represents progress to date.  It fixes the original
> problem in this PR and allows John Reid's version of
> iso_varying_string/vocabulary_word_count.f90 to compile and run
> correctly.  It even bootstraps and regtests!

Attached is a re-diffed patch; I have additionally fixed some indenting 
issues.

Additionally, I have tested the patch - and it fails with 
deferred-length *array* character components. See attached test case. 
Also, the following line of the included test case leaks memory:
     allocate (array(2), source = [t("abcedefg","hi"), t("jkl","mnop")])

I think at least the array bug should be fixed prior committal. (Fixing 
the memory leak and some of the below-mentioned issues would be nice, 
too.) Otherwise, I think the patch looks fine. For completeness, I have 
some naming remarks, which I would also like to considered: 
http://thread.gmane.org/gmane.comp.gcc.fortran/40393/focus=281580

Tobias

> However, it doe not fix:
> PR51976 comment #6 and PR51550 - allocate with typespec ICEs
> PR51976 comment #6 FORALL assignment is messed up and ICEs..
> PR47545 the compiler complains about the lack of an initializer for
> the hidden character length field.
> PR45170 will need going through from one end to the other - there is a
> lot of "stuff" here!
>
> Of these, I consider the fix of the PR47545 problem to be a must and
> the allocate with typespec desirable.

[-- Attachment #2: foo.f90 --]
[-- Type: text/x-fortran, Size: 506 bytes --]

type t
  character(len=:), pointer :: p(:)
  character(len=:), allocatable :: a(:)
end type t
type(T) :: x

character(len=5), target :: y(2)
y = ["abc","def"]

x%p => y
x%a = y

print '(">",a,"<")', x%p ! Doesn't print anything
print '(">",a,"<")', x%a ! Doesn't print anything

print '(">",a,"<")', x%p(1) ! Doesn't print anything
print '(">",a,"<")', x%p(2) ! Doesn't print anything
print '(">",a,"<")', x%a(1) ! Prints "def  " (expected: "abc  ")
print '(">",a,"<")', x%a(2) ! Prints "def  " (okay)
end

[-- Attachment #3: deferred-len-comp.diff --]
[-- Type: text/x-patch, Size: 16857 bytes --]

2013-03-19  Paul Thomas  <pault <at> gcc.gnu.org>

	PR fortran/51976
	* gfortran.h : 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-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 : Prototype for the new function.

2013-03-19  Paul Thomas  <pault <at> gcc.gnu.org>

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

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 76d2797..6956d33 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 d149224..34a55b5 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -2349,7 +2349,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)
@@ -2360,7 +2360,7 @@ build_actual_constructor (gfc_structure_ctor_component **comp_head,
 		return FAILURE;
 	      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);
@@ -2443,7 +2443,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 e9b6fb9..f70a749 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -12539,14 +12539,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 FAILURE;
-	}
-
       /* F2008, C442.  */
       if ((!sym->attr.is_class || c != sym->components)
 	  && c->attr.codimension
@@ -12798,6 +12790,25 @@ resolve_fl_derived0 (gfc_symbol *sym)
 	  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)
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 75fed2f..7a2d5de 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -7308,7 +7308,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 strlen)
 {
   tree tmp;
   tree size;
@@ -7329,7 +7329,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 (strlen != NULL_TREE)
+	size = strlen;
+      else
+	size = TYPE_SIZE_UNIT (TREE_TYPE (type));
+
       if (!no_malloc)
 	{
 	  tmp = gfc_call_malloc (&block, type, size);
@@ -7349,8 +7353,11 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank,
 
       gfc_init_block (&block);
       nelems = get_full_array_size (&block, src, rank);
-      tmp = fold_convert (gfc_array_index_type,
-			  TYPE_SIZE_UNIT (gfc_get_element_type (type)));
+      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,
 			      nelems, tmp);
       if (!no_malloc)
@@ -7391,7 +7398,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);
 }
 
 
@@ -7400,7 +7407,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);
 }
 
 
@@ -7637,6 +7644,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)
 	    {
@@ -7730,8 +7747,25 @@ 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;
+	      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;
 	      tmp = gfc_duplicate_allocatable (dcmp, comp, ctype, rank);
@@ -8183,10 +8217,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 2c3ff1f..c73741d 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1589,6 +1589,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)
@@ -6031,9 +6039,40 @@ 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
+	{
+	  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.  */
+      /* Scalar component (excluding deferred parameters).  */
       gfc_init_se (&se, NULL);
       gfc_init_se (&lse, NULL);
 
@@ -7629,7 +7668,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-stmt.c b/gcc/fortran/trans-stmt.c
index 430b10e..aad0139 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -5009,6 +5009,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 cdac0da..cda26ab 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -2479,12 +2479,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 d7bdf26..986213a 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -1843,3 +1843,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+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;
+}
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 03adfdd..95c1864 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -578,6 +578,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/gfortran.dg/deferred_type_component_1.f90 b/gcc/testsuite/gfortran.dg/deferred_type_component_1.f90
new file mode 100644
index 0000000..17d1ac0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/deferred_type_component_1.f90
@@ -0,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

Re: [Patch, fortran] PR51976 - [F2003] Support deferred-length character components of derived types (allocatable string length)

[Janus Weil]

Hi all,

the patch below has been posted a long time ago, but was never
actually committed (although it seems close to being finished).

Could it still be considered for trunk? I think it is a rather popular
feature, which would be helpful for many users ...

Cheers,
Janus



2013-03-19 22:17 GMT+01:00 Tobias Burnus <burnus@net-b.de>:
> Dear Paul, dear all,
>
>
> On February 24, 2013 Paul Richard Thomas wrote:
>>
>> The attached patch represents progress to date.  It fixes the original
>> problem in this PR and allows John Reid's version of
>> iso_varying_string/vocabulary_word_count.f90 to compile and run
>> correctly.  It even bootstraps and regtests!
>
>
> Attached is a re-diffed patch; I have additionally fixed some indenting
> issues.
>
> Additionally, I have tested the patch - and it fails with deferred-length
> *array* character components. See attached test case. Also, the following
> line of the included test case leaks memory:
>     allocate (array(2), source = [t("abcedefg","hi"), t("jkl","mnop")])
>
> I think at least the array bug should be fixed prior committal. (Fixing the
> memory leak and some of the below-mentioned issues would be nice, too.)
> Otherwise, I think the patch looks fine. For completeness, I have some
> naming remarks, which I would also like to considered:
> http://thread.gmane.org/gmane.comp.gcc.fortran/40393/focus=281580
>
> Tobias
>
>
>> However, it doe not fix:
>> PR51976 comment #6 and PR51550 - allocate with typespec ICEs
>> PR51976 comment #6 FORALL assignment is messed up and ICEs..
>> PR47545 the compiler complains about the lack of an initializer for
>> the hidden character length field.
>> PR45170 will need going through from one end to the other - there is a
>> lot of "stuff" here!
>>
>> Of these, I consider the fix of the PR47545 problem to be a must and
>> the allocate with typespec desirable.

Re: [Patch, fortran] PR51976 - [F2003] Support deferred-length character components of derived types (allocatable string length)

[Janus Weil]

[-- Attachment #1: Type: text/plain, Size: 2447 bytes --]

The patch was not applying cleanly any more, so here is a re-diffed
version for current trunk. It works nicely on the included test case
as well as the one provided by Walter Spector in comment 12 of the PR.

Since, also in the current state, "character(:)" works only in a
subset of all cases, I think it cannot hurt to add more cases that
work for 4.9 (even if still not all possible cases work).

Please let me know what you think ...

Cheers,
Janus




2014-02-19 16:16 GMT+01:00 Janus Weil <janus@gcc.gnu.org>:
> Hi all,
>
> the patch below has been posted a long time ago, but was never
> actually committed (although it seems close to being finished).
>
> Could it still be considered for trunk? I think it is a rather popular
> feature, which would be helpful for many users ...
>
> Cheers,
> Janus
>
>
>
> 2013-03-19 22:17 GMT+01:00 Tobias Burnus <burnus@net-b.de>:
>> Dear Paul, dear all,
>>
>>
>> On February 24, 2013 Paul Richard Thomas wrote:
>>>
>>> The attached patch represents progress to date.  It fixes the original
>>> problem in this PR and allows John Reid's version of
>>> iso_varying_string/vocabulary_word_count.f90 to compile and run
>>> correctly.  It even bootstraps and regtests!
>>
>>
>> Attached is a re-diffed patch; I have additionally fixed some indenting
>> issues.
>>
>> Additionally, I have tested the patch - and it fails with deferred-length
>> *array* character components. See attached test case. Also, the following
>> line of the included test case leaks memory:
>>     allocate (array(2), source = [t("abcedefg","hi"), t("jkl","mnop")])
>>
>> I think at least the array bug should be fixed prior committal. (Fixing the
>> memory leak and some of the below-mentioned issues would be nice, too.)
>> Otherwise, I think the patch looks fine. For completeness, I have some
>> naming remarks, which I would also like to considered:
>> http://thread.gmane.org/gmane.comp.gcc.fortran/40393/focus=281580
>>
>> Tobias
>>
>>
>>> However, it doe not fix:
>>> PR51976 comment #6 and PR51550 - allocate with typespec ICEs
>>> PR51976 comment #6 FORALL assignment is messed up and ICEs..
>>> PR47545 the compiler complains about the lack of an initializer for
>>> the hidden character length field.
>>> PR45170 will need going through from one end to the other - there is a
>>> lot of "stuff" here!
>>>
>>> Of these, I consider the fix of the PR47545 problem to be a must and
>>> the allocate with typespec desirable.

[-- Attachment #2: deferred-len-comp_2014-02-19.diff --]
[-- Type: text/plain, Size: 15151 bytes --]

Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 207896)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -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;
 }
Index: gcc/fortran/primary.c
===================================================================
--- gcc/fortran/primary.c	(revision 207896)
+++ gcc/fortran/primary.c	(working copy)
@@ -2355,7 +2355,7 @@ build_actual_constructor (gfc_structure_ctor_compo
 	}
 
       /* 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_compo
 		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,
 	{
 	  /* 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"
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 207896)
+++ gcc/fortran/resolve.c	(working copy)
@@ -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+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))
+		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)
Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c	(revision 207896)
+++ gcc/fortran/trans-array.c	(working copy)
@@ -7365,7 +7365,7 @@ get_full_array_size (stmtblock_t *block, tree decl
 
 static tree
 duplicate_allocatable (tree dest, tree src, tree type, int rank,
-		       bool no_malloc)
+		       bool no_malloc, tree strlen)
 {
   tree tmp;
   tree size;
@@ -7386,7 +7386,11 @@ duplicate_allocatable (tree dest, tree src, tree t
       null_data = gfc_finish_block (&block);
 
       gfc_init_block (&block);
-      size = TYPE_SIZE_UNIT (TREE_TYPE (type));
+      if (strlen != NULL_TREE)
+	size = strlen;
+      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 t
       else
 	nelems = gfc_index_one_node;
 
-      tmp = fold_convert (gfc_array_index_type,
-			  TYPE_SIZE_UNIT (gfc_get_element_type (type)));
+      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,
 			      nelems, tmp);
       if (!no_malloc)
@@ -7452,7 +7459,7 @@ duplicate_allocatable (tree dest, tree src, tree t
 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, tr
 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
 				     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,9 +7872,26 @@ structure_alloc_comps (gfc_symbol * der_type, tree
 	      continue;
 	    }
 
-	  if (c->attr.allocatable && !c->attr.proc_pointer
-	      && !cmp_has_alloc_comps)
+	  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;
 	      if (c->attr.codimension)
 		tmp = gfc_copy_allocatable_data (dcmp, comp, ctype, rank);
@@ -8342,10 +8376,24 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo
   /* 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)
     {
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(revision 207896)
+++ gcc/fortran/trans-expr.c	(working copy)
@@ -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,40 @@ gfc_trans_subcomponent_assign (tree dest, gfc_comp
 	  gfc_add_expr_to_block (&block, tmp);
 	}
     }
-  else
+  else if (gfc_deferred_strlen (cm, &tmp))
     {
-      /* Scalar component.  */
+      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);
 
@@ -7747,7 +7786,10 @@ alloc_scalar_allocatable_for_assignment (stmtblock
 
       /* 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);
     }
 }
 
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c	(revision 207896)
+++ gcc/fortran/trans-stmt.c	(working copy)
@@ -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)
Index: gcc/fortran/trans-types.c
===================================================================
--- gcc/fortran/trans-types.c	(revision 207896)
+++ gcc/fortran/trans-types.c	(working copy)
@@ -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);
 	}
Index: gcc/fortran/trans.c
===================================================================
--- gcc/fortran/trans.c	(revision 207896)
+++ gcc/fortran/trans.c	(working copy)
@@ -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+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 207896)
+++ gcc/fortran/trans.h	(working copy)
@@ -581,6 +581,9 @@ bool get_array_ctor_strlen (stmtblock_t *, gfc_con
 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,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

Re: [Patch, fortran] PR51976 - [F2003] Support deferred-length character components of derived types (allocatable string length)

[Paul Richard Thomas]

Dear Janus,

I had completely forgotten about this patch... I even thought that it
had been applied :-)

I'll have time, either tomorrow evening or Saturday to take a look.
After nearly 11 months, a couple more days will not hurt!

Thanks for bringing it to my attention.

Paul

On 19 February 2014 16:51, Janus Weil <janus@gcc.gnu.org> wrote:
> The patch was not applying cleanly any more, so here is a re-diffed
> version for current trunk. It works nicely on the included test case
> as well as the one provided by Walter Spector in comment 12 of the PR.
>
> Since, also in the current state, "character(:)" works only in a
> subset of all cases, I think it cannot hurt to add more cases that
> work for 4.9 (even if still not all possible cases work).
>
> Please let me know what you think ...
>
> Cheers,
> Janus
>
>
>
>
> 2014-02-19 16:16 GMT+01:00 Janus Weil <janus@gcc.gnu.org>:
>> Hi all,
>>
>> the patch below has been posted a long time ago, but was never
>> actually committed (although it seems close to being finished).
>>
>> Could it still be considered for trunk? I think it is a rather popular
>> feature, which would be helpful for many users ...
>>
>> Cheers,
>> Janus
>>
>>
>>
>> 2013-03-19 22:17 GMT+01:00 Tobias Burnus <burnus@net-b.de>:
>>> Dear Paul, dear all,
>>>
>>>
>>> On February 24, 2013 Paul Richard Thomas wrote:
>>>>
>>>> The attached patch represents progress to date.  It fixes the original
>>>> problem in this PR and allows John Reid's version of
>>>> iso_varying_string/vocabulary_word_count.f90 to compile and run
>>>> correctly.  It even bootstraps and regtests!
>>>
>>>
>>> Attached is a re-diffed patch; I have additionally fixed some indenting
>>> issues.
>>>
>>> Additionally, I have tested the patch - and it fails with deferred-length
>>> *array* character components. See attached test case. Also, the following
>>> line of the included test case leaks memory:
>>>     allocate (array(2), source = [t("abcedefg","hi"), t("jkl","mnop")])
>>>
>>> I think at least the array bug should be fixed prior committal. (Fixing the
>>> memory leak and some of the below-mentioned issues would be nice, too.)
>>> Otherwise, I think the patch looks fine. For completeness, I have some
>>> naming remarks, which I would also like to considered:
>>> http://thread.gmane.org/gmane.comp.gcc.fortran/40393/focus=281580
>>>
>>> Tobias
>>>
>>>
>>>> However, it doe not fix:
>>>> PR51976 comment #6 and PR51550 - allocate with typespec ICEs
>>>> PR51976 comment #6 FORALL assignment is messed up and ICEs..
>>>> PR47545 the compiler complains about the lack of an initializer for
>>>> the hidden character length field.
>>>> PR45170 will need going through from one end to the other - there is a
>>>> lot of "stuff" here!
>>>>
>>>> Of these, I consider the fix of the PR47545 problem to be a must and
>>>> the allocate with typespec desirable.



-- 
The knack of flying is learning how to throw yourself at the ground and miss.
       --Hitchhikers Guide to the Galaxy

Re: [Patch, fortran] PR51976 - [F2003] Support deferred-length character components of derived types (allocatable string length)

[Tobias Burnus]

Hi Paul,

Paul Richard Thomas wrote:
> I had completely forgotten about this patch... I even thought that it
> had been applied :-) I'll have time, either tomorrow evening or Saturday to take a look.
> After nearly 11 months, a couple more days will not hurt!

I think it went as follows: We found out that some code doesn't - in 
particular code which uses array-valued deferred-length characters. 
After trying to fix it, you (Paul) decided that the simplest way to fix 
it would be the new array descriptor - and then it got stuck.

Regarding this patch, I have mixed feelings. I think it is a much wished 
feature - but I am not sure about the stability of the patch and it is 
rather large, given that we are in stage 4.


Regarding the new array descriptor: I think it would be useful if we 
could get the new descriptor working early in the GCC 4.10/5.0/2015 
development stage. I think the main large task is to convert all all 
remaining stride-based code to stride-multiplier code without breaking 
vectorization and causing other regressions. Additionally, it would be 
nice to get rid of "offset" - and have in the descriptor always an 
lower_bound of 0, except for pointers/allocatables (cf. TS29113). I 
think the version on the branch is in a relatively good shape; however, 
the stride and offset changes seem to be of such a kind that one needs 
to modify several code locations simultaneously - otherwise, it will 
break badly. Additionally, all remaining regressions have to be fixed. 
When that's done, adding some extra field is all what's needed. (As 
follow up, enough remains to be done: I'd like to use it for all 
class(*), possibly even for nonarray class(type), assumed-rank needs an 
update, assumed-shape/-rank/deferred-shape character arrays also have to 
be adapted (also mandated by TS29113 for interop). And we should do an 
ABI cleanup in libgfortran as we have now the chance to break the ABI.) 
- Is anyone volunteering?

Also planned for GCC post-4.9: Getting an initial really working coarray 
version.

(Besides more mundane tasks like finishing finalization, completing OOP 
or ...)

Tobias

Re: [Patch, fortran] PR51976 - [F2003] Support deferred-length character components of derived types (allocatable string length)

[Mikael Morin]

Le 19/02/2014 16:51, Janus Weil a écrit :
> The patch was not applying cleanly any more, so here is a re-diffed
> version for current trunk. It works nicely on the included test case
> as well as the one provided by Walter Spector in comment 12 of the PR.
> 
> Since, also in the current state, "character(:)" works only in a
> subset of all cases, I think it cannot hurt to add more cases that
> work for 4.9 (even if still not all possible cases work).
> 
> Please let me know what you think ...
> 
> Cheers,
> Janus
> 

Review:

>     PR fortran/51976
>     * gfortran.h : Add deferred_parameter attribute.
Add the name of the struct before ':'
like "(struct symbol_attribute)" or maybe just "(symbol_attribute)"

>     * trans.c (gfc_deferred_strlen): New function.
>     * trans.h : Prototype for the new function.
This is really nitpicking but "(gfc_deferred_strlen)" should be in front
of trans.h as well.


Now regarding the patch itself, I don't know character handling very
well, but it seems to me that the patch makes the (wrong) assumption
that characters are of default kind, so that string length is the same
as memory size.
Namely:

> Index: gcc/fortran/trans-array.c
> ===================================================================
> --- gcc/fortran/trans-array.c	(revision 207896)
> +++ gcc/fortran/trans-array.c	(working copy)
> @@ -7365,7 +7365,7 @@ get_full_array_size (stmtblock_t *block, tree decl
>  
>  static tree
>  duplicate_allocatable (tree dest, tree src, tree type, int rank,
> -		       bool no_malloc)
> +		       bool no_malloc, tree strlen)
>  {
>    tree tmp;
>    tree size;
> @@ -7386,7 +7386,11 @@ duplicate_allocatable (tree dest, tree src, tree t
>        null_data = gfc_finish_block (&block);
>  
>        gfc_init_block (&block);
> -      size = TYPE_SIZE_UNIT (TREE_TYPE (type));
> +      if (strlen != NULL_TREE)
> +	size = strlen;
> +      else
> +	size = TYPE_SIZE_UNIT (TREE_TYPE (type));
> +
here...

>        if (!no_malloc)
>  	{
>  	  tmp = gfc_call_malloc (&block, type, size);
> @@ -7410,8 +7414,11 @@ duplicate_allocatable (tree dest, tree src, tree t
>        else
>  	nelems = gfc_index_one_node;
>  
> -      tmp = fold_convert (gfc_array_index_type,
> -			  TYPE_SIZE_UNIT (gfc_get_element_type (type)));
> +      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)));
... and/or here,

>        size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
>  			      nelems, tmp);
>        if (!no_malloc)
> Index: gcc/fortran/trans-expr.c
> ===================================================================
> --- gcc/fortran/trans-expr.c	(revision 207896)
> +++ gcc/fortran/trans-expr.c	(working copy)
> @@ -6043,9 +6051,40 @@ gfc_trans_subcomponent_assign (tree dest, gfc_comp
>  	  gfc_add_expr_to_block (&block, tmp);
>  	}
>      }
> -  else
> +  else if (gfc_deferred_strlen (cm, &tmp))
>      {
> -      /* Scalar component.  */
> +      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);
here,

> +	  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);
>  
> Index: gcc/fortran/trans-stmt.c
> ===================================================================
> --- gcc/fortran/trans-stmt.c	(revision 207896)
> +++ gcc/fortran/trans-stmt.c	(working copy)
> @@ -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));
>  
and here.  There may be other places that I have missed.

>  	      /* Convert to size in bytes, using the character KIND.  */
>  	      if (unlimited_char)

As the patch seems to provide a wanted feature, and as the new code
seems to be properly guarded, I'm not against it after the above has
been checked and fixed if necessary.

Mikael

> Index: gcc/fortran/trans.c
> ===================================================================
> --- gcc/fortran/trans.c	(revision 207896)
> +++ gcc/fortran/trans.c	(working copy)
> @@ -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+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;
maybe gfc_find_component could be used here.

> +  *decl = strlen ? strlen->backend_decl : NULL_TREE;
> +  return strlen != NULL;
> +}

Re: [Patch, fortran] PR51976 - [F2003] Support deferred-length character components of derived types (allocatable string length)

[Steve Kargl]

On Sat, Feb 22, 2014 at 04:38:52PM +0100, Mikael Morin wrote:
> > +
> > +bool
> > +gfc_deferred_strlen (gfc_component *c, tree *decl)
> > +{
> > +  char name[GFC_MAX_SYMBOL_LEN+1];

Shouldn't this be +2?

> > +  gfc_component *strlen;
> > +  if (!(c->ts.type == BT_CHARACTER && c->ts.deferred))
> > +    return false;
> > +  sprintf (name, "_%s", c->name);

One for NULL termination and one for '_' character.

> > +  for (strlen = c; strlen; strlen = strlen->next)
> > +    if (strcmp (strlen->name, name) == 0)
> > +      break;
> maybe gfc_find_component could be used here.
> 
> > +  *decl = strlen ? strlen->backend_decl : NULL_TREE;
> > +  return strlen != NULL;
> > +}

-- 
Steve

Re: [Patch, fortran] PR51976 - [F2003] Support deferred-length character components of derived types (allocatable string length)

[Janus Weil]

[-- Attachment #1: Type: text/plain, Size: 8475 bytes --]

Hi Mikael, hi all,

2014-02-22 16:38 GMT+01:00 Mikael Morin <mikael.morin@sfr.fr>:
> Le 19/02/2014 16:51, Janus Weil a écrit :
>> The patch was not applying cleanly any more, so here is a re-diffed
>> version for current trunk. It works nicely on the included test case
>> as well as the one provided by Walter Spector in comment 12 of the PR.
>>
>> Since, also in the current state, "character(:)" works only in a
>> subset of all cases, I think it cannot hurt to add more cases that
>> work for 4.9 (even if still not all possible cases work).
>>
>> Please let me know what you think ...
>
> Review:
>
>>     PR fortran/51976
>>     * gfortran.h : Add deferred_parameter attribute.
> Add the name of the struct before ':'
> like "(struct symbol_attribute)" or maybe just "(symbol_attribute)"
>
>>     * trans.c (gfc_deferred_strlen): New function.
>>     * trans.h : Prototype for the new function.
> This is really nitpicking but "(gfc_deferred_strlen)" should be in front
> of trans.h as well.

Done.


> Now regarding the patch itself, I don't know character handling very
> well, but it seems to me that the patch makes the (wrong) assumption
> that characters are of default kind, so that string length is the same
> as memory size.
> Namely:
>
>> Index: gcc/fortran/trans-array.c
>> ===================================================================
>> --- gcc/fortran/trans-array.c (revision 207896)
>> +++ gcc/fortran/trans-array.c (working copy)
>> @@ -7365,7 +7365,7 @@ get_full_array_size (stmtblock_t *block, tree decl
>>
>>  static tree
>>  duplicate_allocatable (tree dest, tree src, tree type, int rank,
>> -                    bool no_malloc)
>> +                    bool no_malloc, tree strlen)
>>  {
>>    tree tmp;
>>    tree size;
>> @@ -7386,7 +7386,11 @@ duplicate_allocatable (tree dest, tree src, tree t
>>        null_data = gfc_finish_block (&block);
>>
>>        gfc_init_block (&block);
>> -      size = TYPE_SIZE_UNIT (TREE_TYPE (type));
>> +      if (strlen != NULL_TREE)
>> +     size = strlen;
>> +      else
>> +     size = TYPE_SIZE_UNIT (TREE_TYPE (type));
>> +
> here...

Fixed (but actually in the code which calls duplicate_allocatable).


>>        size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
>>                             nelems, tmp);
>>        if (!no_malloc)
>> Index: gcc/fortran/trans-expr.c
>> ===================================================================
>> --- gcc/fortran/trans-expr.c  (revision 207896)
>> +++ gcc/fortran/trans-expr.c  (working copy)
>> @@ -6043,9 +6051,40 @@ gfc_trans_subcomponent_assign (tree dest, gfc_comp
>>         gfc_add_expr_to_block (&block, tmp);
>>       }
>>      }
>> -  else
>> +  else if (gfc_deferred_strlen (cm, &tmp))
>>      {
>> -      /* Scalar component.  */
>> +      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);
> here,

Also fixed (again by using size_of_string_in_bytes).


>> +       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);
>>
>> Index: gcc/fortran/trans-stmt.c
>> ===================================================================
>> --- gcc/fortran/trans-stmt.c  (revision 207896)
>> +++ gcc/fortran/trans-stmt.c  (working copy)
>> @@ -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));
>>
> and here.  There may be other places that I have missed.

Actually I don't see a problem here. Also no further modifications
were necessary to get a KIND=4 example to work.


>>             /* Convert to size in bytes, using the character KIND.  */
>>             if (unlimited_char)
>
> As the patch seems to provide a wanted feature, and as the new code
> seems to be properly guarded, I'm not against it after the above has
> been checked and fixed if necessary.

Attached is a new version of the patch which fixes the above-mentioned
problems and should make the non-default-kind cases work. I have added
a KIND=4 version of the original test case, which seems to work
properly.

The patch was regtested on x86_64-unknown-linux-gnu. Ok for trunk?

Btw, there was quite some user feedback along the lines of "we want
this feature", but there was not a lot of actual testing. So, if you
are interested in this feature, please try the patch and report back
here with things like "I tested it and it works great on my 100kLOC
code" or "I tested it and found the following problem ..."

Cheers,
Janus



2014-03-01  Paul Thomas  <pault <at> 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  Paul Thomas  <pault <at> 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.

[-- Attachment #2: deferred-len-comp_2014-03-01.diff --]
[-- Type: text/plain, Size: 18409 bytes --]

Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 208241)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -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;
 }
Index: gcc/fortran/primary.c
===================================================================
--- gcc/fortran/primary.c	(revision 208241)
+++ gcc/fortran/primary.c	(working copy)
@@ -2355,7 +2355,7 @@ build_actual_constructor (gfc_structure_ctor_compo
 	}
 
       /* 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_compo
 		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,
 	{
 	  /* 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"
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 208241)
+++ gcc/fortran/resolve.c	(working copy)
@@ -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+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))
+		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)
Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c	(revision 208241)
+++ gcc/fortran/trans-array.c	(working copy)
@@ -7365,7 +7365,7 @@ get_full_array_size (stmtblock_t *block, tree decl
 
 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 t
       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 t
       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 t
 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, tr
 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
 				     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,9 +7872,27 @@ structure_alloc_comps (gfc_symbol * der_type, tree
 	      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)
 		tmp = gfc_copy_allocatable_data (dcmp, comp, ctype, rank);
@@ -8342,10 +8377,24 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo
   /* 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)
     {
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(revision 208241)
+++ gcc/fortran/trans-expr.c	(working copy)
@@ -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_comp
 	  gfc_add_expr_to_block (&block, tmp);
 	}
     }
-  else
+  else if (gfc_deferred_strlen (cm, &tmp))
     {
-      /* Scalar component.  */
+      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 (excluding deferred parameters).  */
       gfc_init_se (&se, NULL);
       gfc_init_se (&lse, NULL);
 
@@ -7747,7 +7788,10 @@ alloc_scalar_allocatable_for_assignment (stmtblock
 
       /* 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);
     }
 }
 
Index: gcc/fortran/trans-intrinsic.c
===================================================================
--- gcc/fortran/trans-intrinsic.c	(revision 208241)
+++ gcc/fortran/trans-intrinsic.c	(working copy)
@@ -5166,7 +5166,7 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * e
    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;
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c	(revision 208241)
+++ gcc/fortran/trans-stmt.c	(working copy)
@@ -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)
Index: gcc/fortran/trans-types.c
===================================================================
--- gcc/fortran/trans-types.c	(revision 208241)
+++ gcc/fortran/trans-types.c	(working copy)
@@ -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);
 	}
Index: gcc/fortran/trans.c
===================================================================
--- gcc/fortran/trans.c	(revision 208241)
+++ gcc/fortran/trans.c	(working copy)
@@ -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+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 208241)
+++ gcc/fortran/trans.h	(working copy)
@@ -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_con
 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,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
Index: gcc/testsuite/gfortran.dg/deferred_type_component_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/deferred_type_component_2.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/deferred_type_component_2.f90	(working copy)
@@ -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

Re: [Patch, fortran] PR51976 - [F2003] Support deferred-length character components of derived types (allocatable string length)

[Mikael Morin]

Le 01/03/2014 16:58, Janus Weil a écrit :
>>> Index: gcc/fortran/trans-stmt.c
>>> ===================================================================
>>> --- gcc/fortran/trans-stmt.c  (revision 207896)
>>> +++ gcc/fortran/trans-stmt.c  (working copy)
>>> @@ -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));
>>>
>> and here.  There may be other places that I have missed.
> 
> Actually I don't see a problem here. Also no further modifications
> were necessary to get a KIND=4 example to work.
> 
Mmmh, yes indeed.  I assumed memsz was the memory size, which it isn't
until a few lines down.  Thanks for checking.

> 
>>>             /* Convert to size in bytes, using the character KIND.  */
>>>             if (unlimited_char)
>>
>> As the patch seems to provide a wanted feature, and as the new code
>> seems to be properly guarded, I'm not against it after the above has
>> been checked and fixed if necessary.
> 
> Attached is a new version of the patch which fixes the above-mentioned
> problems and should make the non-default-kind cases work. I have added
> a KIND=4 version of the original test case, which seems to work
> properly.
> 
> The patch was regtested on x86_64-unknown-linux-gnu. Ok for trunk?
> 
I'm asking for one more minor change, namely:

> @@ -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+1];
> +	  gfc_component *strlen;
> +	  sprintf (name, "_%s", c->name);

It's not more costly to have a more explicit name like "_%s_length" or
something, and I prefer having the latter in complicated dumps or in the
debugger.
OK with that change, with the associated buffer size update.  Also Steve
noted that the buffer size should take the terminating null character
into account.

Thanks for the patch.
Mikael

Re: [Patch, fortran] PR51976 - [F2003] Support deferred-length character components of derived types (allocatable string length)

[Janus Weil]

[-- Attachment #1: Type: text/plain, Size: 1261 bytes --]

Hi Mikael,

>> The patch was regtested on x86_64-unknown-linux-gnu. Ok for trunk?
>>
> I'm asking for one more minor change, namely:
>
>> @@ -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+1];
>> +       gfc_component *strlen;
>> +       sprintf (name, "_%s", c->name);
>
> It's not more costly to have a more explicit name like "_%s_length" or
> something, and I prefer having the latter in complicated dumps or in the
> debugger.

I agree.


> OK with that change, with the associated buffer size update.  Also Steve
> noted that the buffer size should take the terminating null character
> into account.

Steve's comment somehow got lost in the noise. I have updated both the
name and the buffer size now in resolve_fl_derived0 as well as
gfc_deferred_strlen. Updated patch attached.

A few people expressed mixed feelings, therefore I'll wait a couple of
days to allow the naysayers to chime in. In the absence of further
feedback, I'll commit the patch on the weekend.

Cheers,
Janus

[-- Attachment #2: deferred-len-comp_2014-03-05.diff --]
[-- Type: text/plain, Size: 18423 bytes --]

Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 208344)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -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;
 }
Index: gcc/fortran/primary.c
===================================================================
--- gcc/fortran/primary.c	(revision 208344)
+++ gcc/fortran/primary.c	(working copy)
@@ -2355,7 +2355,7 @@ build_actual_constructor (gfc_structure_ctor_compo
 	}
 
       /* 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_compo
 		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,
 	{
 	  /* 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"
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 208344)
+++ gcc/fortran/resolve.c	(working copy)
@@ -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)
Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c	(revision 208344)
+++ gcc/fortran/trans-array.c	(working copy)
@@ -7365,7 +7365,7 @@ get_full_array_size (stmtblock_t *block, tree decl
 
 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 t
       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 t
       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 t
 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, tr
 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
 				     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,9 +7872,27 @@ structure_alloc_comps (gfc_symbol * der_type, tree
 	      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)
 		tmp = gfc_copy_allocatable_data (dcmp, comp, ctype, rank);
@@ -8342,10 +8377,24 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo
   /* 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)
     {
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(revision 208344)
+++ gcc/fortran/trans-expr.c	(working copy)
@@ -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_comp
 	  gfc_add_expr_to_block (&block, tmp);
 	}
     }
-  else
+  else if (gfc_deferred_strlen (cm, &tmp))
     {
-      /* Scalar component.  */
+      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 (excluding deferred parameters).  */
       gfc_init_se (&se, NULL);
       gfc_init_se (&lse, NULL);
 
@@ -7747,7 +7788,10 @@ alloc_scalar_allocatable_for_assignment (stmtblock
 
       /* 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);
     }
 }
 
Index: gcc/fortran/trans-intrinsic.c
===================================================================
--- gcc/fortran/trans-intrinsic.c	(revision 208344)
+++ gcc/fortran/trans-intrinsic.c	(working copy)
@@ -5166,7 +5166,7 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * e
    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;
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c	(revision 208344)
+++ gcc/fortran/trans-stmt.c	(working copy)
@@ -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)
Index: gcc/fortran/trans-types.c
===================================================================
--- gcc/fortran/trans-types.c	(revision 208344)
+++ gcc/fortran/trans-types.c	(working copy)
@@ -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);
 	}
Index: gcc/fortran/trans.c
===================================================================
--- gcc/fortran/trans.c	(revision 208344)
+++ gcc/fortran/trans.c	(working copy)
@@ -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;
+}
Index: gcc/fortran/trans.h
===================================================================
--- gcc/fortran/trans.h	(revision 208344)
+++ gcc/fortran/trans.h	(working copy)
@@ -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_con
 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,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
Index: gcc/testsuite/gfortran.dg/deferred_type_component_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/deferred_type_component_2.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/deferred_type_component_2.f90	(working copy)
@@ -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

Re: [Patch, fortran] PR51976 - [F2003] Support deferred-length character components of derived types (allocatable string length)

[Janus Weil]

Hi Paul,

> I am trying to respond to Mikael's comment that only kind=1 is handled. I'll
> use your patch as a basis.

actually the last version of the patch that I posted yesterday should
already handle that (and includes a kind=4 test case). But if you find
any remaining problems, please let me know.

Also Tobias already told me privately that his "mixed feeling" were
not strong enough to oppose against committing the patch. So right now
the only thing standing between the patch and trunk seems to be you ;)

Cheers,
Janus



> On Mar 5, 2014 2:53 PM, "Janus Weil" <janus@gcc.gnu.org> wrote:
>>
>> Hi Mikael,
>>
>> >> The patch was regtested on x86_64-unknown-linux-gnu. Ok for trunk?
>> >>
>> > I'm asking for one more minor change, namely:
>> >
>> >> @@ -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+1];
>> >> +       gfc_component *strlen;
>> >> +       sprintf (name, "_%s", c->name);
>> >
>> > It's not more costly to have a more explicit name like "_%s_length" or
>> > something, and I prefer having the latter in complicated dumps or in the
>> > debugger.
>>
>> I agree.
>>
>>
>> > OK with that change, with the associated buffer size update.  Also Steve
>> > noted that the buffer size should take the terminating null character
>> > into account.
>>
>> Steve's comment somehow got lost in the noise. I have updated both the
>> name and the buffer size now in resolve_fl_derived0 as well as
>> gfc_deferred_strlen. Updated patch attached.
>>
>> A few people expressed mixed feelings, therefore I'll wait a couple of
>> days to allow the naysayers to chime in. In the absence of further
>> feedback, I'll commit the patch on the weekend.
>>
>> Cheers,
>> Janus

Re: [Patch, fortran] PR51976 - [F2003] Support deferred-length character components of derived types (allocatable string length)

[Janus Weil]

Hi,

> In that case, go for it! I am on vacation in Tenerife right now and have
> very limited access.

wow, in that case I guess you better enjoy your holidays ;)


> Please commit the patch to trunk.

Will do!

Thanks,
Janus




> On Mar 6, 2014 9:59 PM, "Janus Weil" <janus@gcc.gnu.org> wrote:
>>
>> Hi Paul,
>>
>> > I am trying to respond to Mikael's comment that only kind=1 is handled.
>> > I'll
>> > use your patch as a basis.
>>
>> actually the last version of the patch that I posted yesterday should
>> already handle that (and includes a kind=4 test case). But if you find
>> any remaining problems, please let me know.
>>
>> Also Tobias already told me privately that his "mixed feeling" were
>> not strong enough to oppose against committing the patch. So right now
>> the only thing standing between the patch and trunk seems to be you ;)
>>
>> Cheers,
>> Janus
>>
>>
>>
>> > On Mar 5, 2014 2:53 PM, "Janus Weil" <janus@gcc.gnu.org> wrote:
>> >>
>> >> Hi Mikael,
>> >>
>> >> >> The patch was regtested on x86_64-unknown-linux-gnu. Ok for trunk?
>> >> >>
>> >> > I'm asking for one more minor change, namely:
>> >> >
>> >> >> @@ -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+1];
>> >> >> +       gfc_component *strlen;
>> >> >> +       sprintf (name, "_%s", c->name);
>> >> >
>> >> > It's not more costly to have a more explicit name like "_%s_length"
>> >> > or
>> >> > something, and I prefer having the latter in complicated dumps or in
>> >> > the
>> >> > debugger.
>> >>
>> >> I agree.
>> >>
>> >>
>> >> > OK with that change, with the associated buffer size update.  Also
>> >> > Steve
>> >> > noted that the buffer size should take the terminating null character
>> >> > into account.
>> >>
>> >> Steve's comment somehow got lost in the noise. I have updated both the
>> >> name and the buffer size now in resolve_fl_derived0 as well as
>> >> gfc_deferred_strlen. Updated patch attached.
>> >>
>> >> A few people expressed mixed feelings, therefore I'll wait a couple of
>> >> days to allow the naysayers to chime in. In the absence of further
>> >> feedback, I'll commit the patch on the weekend.
>> >>
>> >> Cheers,
>> >> Janus

Re: [Patch, fortran] PR51976 - [F2003] Support deferred-length character components of derived types (allocatable string length)

[Janus Weil]

>> Please commit the patch to trunk.
>
> Will do!

I have just committed the patch as r208386, thereby implementing
deferred-length character components on 4.9 trunk. One big plea to the
users: Please test this as soon as possible!

Cheers,
Janus



>> On Mar 6, 2014 9:59 PM, "Janus Weil" <janus@gcc.gnu.org> wrote:
>>>
>>> Hi Paul,
>>>
>>> > I am trying to respond to Mikael's comment that only kind=1 is handled.
>>> > I'll
>>> > use your patch as a basis.
>>>
>>> actually the last version of the patch that I posted yesterday should
>>> already handle that (and includes a kind=4 test case). But if you find
>>> any remaining problems, please let me know.
>>>
>>> Also Tobias already told me privately that his "mixed feeling" were
>>> not strong enough to oppose against committing the patch. So right now
>>> the only thing standing between the patch and trunk seems to be you ;)
>>>
>>> Cheers,
>>> Janus
>>>
>>>
>>>
>>> > On Mar 5, 2014 2:53 PM, "Janus Weil" <janus@gcc.gnu.org> wrote:
>>> >>
>>> >> Hi Mikael,
>>> >>
>>> >> >> The patch was regtested on x86_64-unknown-linux-gnu. Ok for trunk?
>>> >> >>
>>> >> > I'm asking for one more minor change, namely:
>>> >> >
>>> >> >> @@ -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+1];
>>> >> >> +       gfc_component *strlen;
>>> >> >> +       sprintf (name, "_%s", c->name);
>>> >> >
>>> >> > It's not more costly to have a more explicit name like "_%s_length"
>>> >> > or
>>> >> > something, and I prefer having the latter in complicated dumps or in
>>> >> > the
>>> >> > debugger.
>>> >>
>>> >> I agree.
>>> >>
>>> >>
>>> >> > OK with that change, with the associated buffer size update.  Also
>>> >> > Steve
>>> >> > noted that the buffer size should take the terminating null character
>>> >> > into account.
>>> >>
>>> >> Steve's comment somehow got lost in the noise. I have updated both the
>>> >> name and the buffer size now in resolve_fl_derived0 as well as
>>> >> gfc_deferred_strlen. Updated patch attached.
>>> >>
>>> >> A few people expressed mixed feelings, therefore I'll wait a couple of
>>> >> days to allow the naysayers to chime in. In the absence of further
>>> >> feedback, I'll commit the patch on the weekend.
>>> >>
>>> >> Cheers,
>>> >> Janus