[multiple changes]

2017-05-19  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-19  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.

2017-05-19  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/80333
	* gfortran.dg/dtio_30.f03: New test.

From-SVN: r248293

6 files changed, 120 insertions, 11 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 928e5bb..76418d9 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2017-05-19  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-19  David Malcolm  <dmalcolm@redhat.com>
 
 	PR fortran/79852
diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index c557c11..c3c56f2 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
@@ -1670,8 +1674,12 @@ 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;
+  ts = sym ? &sym->ts : &c->ts;
+
+  if (ts->type != BT_CLASS)
+    as = sym ? sym->as : c->as;
+  else
+    as = sym ? CLASS_DATA (sym)->as : CLASS_DATA (c)->as;
 
   addr_expr = nml_get_addr_expr (sym, c, base_addr);
 
@@ -1680,9 +1688,12 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name,
 
   if (rank)
     {
-      decl = (sym) ? sym->backend_decl : c->backend_decl;
+      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/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index dafa034..fb4b1bd 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2017-05-19  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR libgfortran/80333
+	* gfortran.dg/dtio_30.f03: New test.
+
 2017-05-19  Marek Polacek  <polacek@redhat.com>
 
 	PR sanitizer/80800
diff --git a/gcc/testsuite/gfortran.dg/dtio_30.f03 b/gcc/testsuite/gfortran.dg/dtio_30.f03
new file mode 100644
index 0000000..9edc8f3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dtio_30.f03
@@ -0,0 +1,60 @@
+! { 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
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 7fe527d..4ada8b8 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,11 @@
+2017-05-19  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.
+
 2017-05-17  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR libgfortran/80741
diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index 9175a6b..6c00d11 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;
+	}
+      else
+	{
+	  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 we are finished with the repeat count, try to read next value.  */
 
@@ -2958,6 +2976,7 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info *nl, index_type offset,
 	    break;
 
 	  case BT_DERIVED:
+	  case BT_CLASS:
 	    /* If this object has a User Defined procedure, call it.  */
 	    if (nl->dtio_sub != NULL)
 	      {
@@ -2970,13 +2989,11 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info *nl, index_type offset,
 		int noiostat;
 		int *child_iostat = NULL;
 		gfc_array_i4 vlist;
-		gfc_class list_obj;
 		formatted_dtio dtio_ptr = (formatted_dtio)nl->dtio_sub;
 
 		GFC_DESCRIPTOR_DATA(&vlist) = NULL;
 		GFC_DIMENSION_SET(vlist.dim[0],1, 0, 0);
-
-		list_obj.data = (void *)nl->mem_pos;
+		
 		list_obj.vptr = nl->vtable;
 		list_obj.len = 0;