[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

4 files changed, 87 insertions, 3 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