On Thu, May 18, 2017 at 05:16:45PM -0700, Jerry DeLisle wrote:
>
> 2017-05-18 Paul Thomas <pa...@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 <pa...@gcc.gnu.org>
> Jerry DeLisle <jvdeli...@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
