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

[Mikael Morin <mikael dot morin at sfr dot 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 ...
> 
> 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;
> +}