[fortran] PR80333 Namelist dtio write of array of class does not traverse the array

Hello,

With some important help from Paul regarding how to access the class data and 
array specs, we have the attached patch.

This fixes both READ and WRITE of arrays of class/type objects.  The namelist 
routines are updated to set the array specifications correctly in the frontend 
so that the call to set the namelist dimensions is completed.

Likewise in the NAMELIST READ arena, we have to then take the given loop 
specification information and compute the index into the class/type data and set 
pointers to the right place on the array.  The existing namelist code already 
sequences through the loop and needed to be initialized correctly.

Regression tested on x86_64. New test case attached. The test case is little 
interesting. You will see use of the unlimited repeat specifier '*' on the DT 
format specifier. One can see how useful that is when you have allocated arrays 
that could change during program execution. (Just a little side note)

OK for trunk? and then to 7 in about a week?

Regards,

Jerry

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.
! { dg-do run }
! PR80333  Namelist dtio write of array of class does not traverse the array
! This test checks both NAMELIST WRITE and READ of an array of class
module m
  implicit none
  type :: t
    character :: c
    character :: d
  contains
    procedure :: read_formatted
    generic :: read(formatted) => read_formatted
    procedure :: write_formatted
    generic :: write(formatted) => write_formatted
  end type t
contains
  subroutine read_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
    class(t), intent(inout) :: dtv
    integer, intent(in) :: unit
    character(*), intent(in) :: iotype
    integer, intent(in) :: v_list(:)
    integer, intent(out) :: iostat
    character(*), intent(inout) :: iomsg
    integer :: i
    read(unit,'(a1,a1)', iostat=iostat, iomsg=iomsg) dtv%c, dtv%d
  end subroutine read_formatted

  subroutine write_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
    class(t), intent(in) :: dtv
    integer, intent(in) :: unit
    character(*), intent(in) :: iotype
    integer, intent(in) :: v_list(:)
    integer, intent(out) :: iostat
    character(*), intent(inout) :: iomsg
    write(unit,'(a1,a1)', iostat=iostat, iomsg=iomsg) dtv%c, dtv%d
  end subroutine write_formatted
end module m

program p
  use m
  implicit none
  class(t), dimension(:,:), allocatable :: w
  namelist /nml/  w
  integer :: unit, iostatus
  character(256) :: str = ""

  open(10, status='scratch')
  allocate(w(10,3))
  w = t('j','r')
  w(5:7,2)%c='k'
  write(10, nml)
  rewind(10)
  w = t('p','z')
  read(10, nml)
  write(str,*) w
  if (str.ne." jr jr jr jr jr jr jr jr jr jr jr jr jr jr kr kr kr jr jr jr jr jr jr jr jr jr jr jr jr jr") &
      & call abort
  str = ""
  write(str,"(*(DT))") w
  if (str.ne."jrjrjrjrjrjrjrjrjrjrjrjrjrjrkrkrkrjrjrjrjrjrjrjrjrjrjrjrjrjr") call abort
end program p

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.

On 05/18/2017 07:06 PM, Steve Kargl wrote:
> 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.
> 
> 

Agreed on style changes. Fixed those, recompiled, retested, and ...
Committed r248293
	A	gcc/testsuite/gfortran.dg/dtio_30.f03
	M	gcc/testsuite/ChangeLog
	M	gcc/fortran/ChangeLog
	M	gcc/fortran/trans-io.c
	M	libgfortran/ChangeLog
	M	libgfortran/io/list_read.c

Thanks for review.

Jerry