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

Jerry DeLisle jvdelisle@charter.net
Fri May 19 02:06:00 GMT 2017


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.
-------------- next part --------------
A non-text attachment was scrubbed...
Name: pr80333.diff
Type: text/x-patch
Size: 3809 bytes
Desc: not available
URL: <http://gcc.gnu.org/pipermail/gcc-patches/attachments/20170519/b0a9a921/attachment.bin>
-------------- next part --------------
! { 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


More information about the Gcc-patches mailing list