Re: [PATCH] Fortran: fix CLASS attribute handling [PR106856]

[Mikael Morin <morin-mikael@orange.fr>]

Le 03/03/2023 à 22:24, Mikael Morin a écrit :
> 
> I have two comments, one about the handling of as and sym->as, which I 
> quite don't understand, but I haven't had time to write something about it.
I have found the time finally.  It's not as bad as it seemed.  See below.

> diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
> index eec0314cf4c..72d8c6f1c14 100644
> --- a/gcc/fortran/decl.cc
> +++ b/gcc/fortran/decl.cc
> @@ -8740,45 +8740,23 @@ attr_decl1 (void)
>  	}
>      }
> 
> -  /* Update symbol table.  DIMENSION attribute is set in
> -     gfc_set_array_spec().  For CLASS variables, this must be applied
> -     to the first component, or '_data' field.  */
>    if (sym->ts.type == BT_CLASS
>        && sym->ts.u.derived
>        && sym->ts.u.derived->attr.is_class)
>      {
> -      /* gfc_set_array_spec sets sym->attr not CLASS_DATA(sym)->attr.  Check
> -	 for duplicate attribute here.  */
> -      if (CLASS_DATA(sym)->attr.dimension == 1 && as)
> -	{
> -	  gfc_error ("Duplicate DIMENSION attribute at %C");
> -	  m = MATCH_ERROR;
> -	  goto cleanup;
> -	}
> -
> -      if (!gfc_copy_attr (&CLASS_DATA(sym)->attr, &current_attr, &var_locus))
> -	{
> -	  m = MATCH_ERROR;
> -	  goto cleanup;
> -	}
> +      sym->attr.pointer = CLASS_DATA(sym)->attr.class_pointer;
> +      sym->attr.allocatable = CLASS_DATA(sym)->attr.allocatable;
> +      sym->attr.dimension = CLASS_DATA(sym)->attr.dimension;
> +      sym->attr.codimension = CLASS_DATA(sym)->attr.codimension;
> +      if (as && CLASS_DATA (sym)->as)
> +	sym->as = gfc_copy_array_spec (CLASS_DATA (sym)->as);

Here the condition on 'CLASS_DATA(sym)->as' makes obviously sense, but I 
don't see why there is also a condition on 'as'.

For example, if the array spec has been previously set on the class 
container's first component, and there is no array spec information in 
the current statement (i.e. as == NULL), sym->as will remain NULL, and a 
non-array class container will be built in gfc_build_class_symbol below.

>      }
> -  else
> -    {
> -      if (current_attr.dimension == 0 && current_attr.codimension == 0
> -	  && !gfc_copy_attr (&sym->attr, &current_attr, &var_locus))
> -	{
> -	  m = MATCH_ERROR;
> -	  goto cleanup;
> -	}
> -    }
> -
> -  if (sym->ts.type == BT_CLASS
> -      && !gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as))
> +  if (current_attr.dimension == 0 && current_attr.codimension == 0
> +      && !gfc_copy_attr (&sym->attr, &current_attr, &var_locus))
>      {
>        m = MATCH_ERROR;
>        goto cleanup;
>      }
> -
>    if (!gfc_set_array_spec (sym, as, &var_locus))
>      {
>        m = MATCH_ERROR;
> @@ -8807,6 +8785,27 @@ attr_decl1 (void)
>        goto cleanup;
>      }
> 
> +  if (sym->ts.type == BT_CLASS && sym->ts.u.derived->attr.is_class
> +      && !as && !current_attr.pointer && !current_attr.allocatable
> +      && !current_attr.external)
> +    {
> +      sym->attr.pointer = 0;
> +      sym->attr.allocatable = 0;
> +      sym->attr.dimension = 0;
> +      sym->attr.codimension = 0;

> +      gfc_free_array_spec (sym->as);
sym->as should probably be reset to NULL here.
Maybe both calls to gfc_free_array_spec here and to gfc_copy_array_spec 
above can be avoided by doing a simple pointer copy?

> +    }
> +  else if (sym->ts.type == BT_CLASS
> +      && !gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as))
> +    {
> +      m = MATCH_ERROR;
> +      goto cleanup;
> +    }
> +  else if (sym->ts.type == BT_CLASS
> +	   && sym->ts.u.derived->attr.is_class
> +	   && sym->old_symbol && sym->old_symbol->as == CLASS_DATA (sym)->as)
> +    sym->old_symbol->as = NULL;
> +
>    add_hidden_procptr_result (sym);
> 
>    return MATCH_YES;