Re: [patch, fortran] PR80333 Namelist dtio write of array of class does not traverse the array

[Steve Kargl <sgk at troutmask dot apl dot washington dot edu>]

On Thu, May 18, 2017 at 05:16:45PM -0700, Jerry DeLisle wrote:
> 
> 2017-05-18  Paul Thomas  <pault@gcc.gnu.org>
> 
> 	PR fortran/80333
> 	* trans-io.c (nml_get_addr_expr): If we are dealing with class
> 	type data set tmp tree to get that address.
> 	(transfer_namelist_element): Set the array spec to point to the
> 	the class data.
> 
> 2017-05-18  Paul Thomas  <pault@gcc.gnu.org>
> 	    Jerry DeLisle  <jvdelisle@gcc.gnu.org>
> 
> 	PR fortran/80333
> 	* list_read.c (nml_read_obj): Compute pointer into class/type
> 	arrays from the nl->dim information. Update it for each iteration
> 	of the loop for the given object.

Looks ok to me.  A few style comments below.


> diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
> index c557c114..a81a0c16 100644
> --- a/gcc/fortran/trans-io.c
> +++ b/gcc/fortran/trans-io.c
> @@ -1613,6 +1613,10 @@ nml_get_addr_expr (gfc_symbol * sym, gfc_component * c,
>      tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
>  			   base_addr, tmp, NULL_TREE);
>  
> +  if (GFC_CLASS_TYPE_P (TREE_TYPE (tmp))
> +      && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (gfc_class_data_get (tmp))))
> +    tmp = gfc_class_data_get (tmp);
> +
>    if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
>      tmp = gfc_conv_array_data (tmp);
>    else
> @@ -1671,7 +1675,11 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name,
>    /* Build ts, as and data address using symbol or component.  */
>  
>    ts = (sym) ? &sym->ts : &c->ts;
> -  as = (sym) ? sym->as : c->as;
> +
> +  if (ts->type != BT_CLASS)
> +    as = (sym) ? sym->as : c->as;
> +  else
> +    as = (sym) ? CLASS_DATA (sym)->as : CLASS_DATA (c)->as;

Why are there parentheses around the conditional?  Something like

+    as = sym ? sym->as : c->as;

should work, no?

>  
>    addr_expr = nml_get_addr_expr (sym, c, base_addr);
>  
> @@ -1683,6 +1691,9 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name,
>        decl = (sym) ? sym->backend_decl : c->backend_decl;
>        if (sym && sym->attr.dummy)
>          decl = build_fold_indirect_ref_loc (input_location, decl);
> +
> +      if (ts->type == BT_CLASS)
> +	decl = gfc_class_data_get (decl);
>        dt =  TREE_TYPE (decl);
>        dtype = gfc_get_dtype (dt);
>      }
> diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
> index 9175a6bb..d8d06823 100644
> --- a/libgfortran/io/list_read.c
> +++ b/libgfortran/io/list_read.c
> @@ -2871,6 +2871,7 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info *nl, index_type offset,
>    index_type m;
>    size_t obj_name_len;
>    void *pdata;
> +  gfc_class list_obj;
>  
>    /* If we have encountered a previous read error or this object has not been
>       touched in name parsing, just return.  */
> @@ -2909,11 +2910,28 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info *nl, index_type offset,
>      {
>        /* Update the pointer to the data, using the current index vector  */
>  
> -      pdata = (void*)(nl->mem_pos + offset);
> -      for (dim = 0; dim < nl->var_rank; dim++)
> -	pdata = (void*)(pdata + (nl->ls[dim].idx
> -				 - GFC_DESCRIPTOR_LBOUND(nl,dim))
> -			* GFC_DESCRIPTOR_STRIDE(nl,dim) * nl->size);
> +      if ((nl->type == BT_DERIVED || nl->type == BT_CLASS)
> +	  && nl->dtio_sub != NULL)
> +	{
> +	  pdata = NULL;  /* Not used under these conidtions.  */
> +	  if (nl->type == BT_CLASS)
> +	    list_obj.data = ((gfc_class*)nl->mem_pos)->data;
> +	  else
> +	    list_obj.data = (void *)nl->mem_pos;
> +
> +	  for (dim = 0; dim < nl->var_rank; dim++)
> +	    list_obj.data = list_obj.data + (nl->ls[dim].idx
> +					- GFC_DESCRIPTOR_LBOUND(nl,dim))
> +			    * GFC_DESCRIPTOR_STRIDE(nl,dim) * nl->size;

The spacing in the above expression and a similar below seems odd.  I suggest
wrapping at the first +.

	    list_obj.data = list_obj.data
	      + (nl->ls[dim].idx - GFC_DESCRIPTOR_LBOUND(nl,dim))
	      * GFC_DESCRIPTOR_STRIDE(nl,dim) * nl->size;

This, to me, seems more readable.

-- 
Steve
20170425 https://www.youtube.com/watch?v=VWUpyCsUKR4
20161221 https://www.youtube.com/watch?v=IbCHE-hONow