public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
* [patch, gfortran] PR48298 DTIO, implement size=
@ 2016-10-18  1:03 Jerry DeLisle
  2016-10-18  2:45 ` Steve Kargl
  2016-10-19 11:04 ` Andreas Schwab
  0 siblings, 2 replies; 9+ messages in thread
From: Jerry DeLisle @ 2016-10-18  1:03 UTC (permalink / raw)
  To: fortran; +Cc: GCC Patches

[-- Attachment #1: Type: text/plain, Size: 1238 bytes --]

Hi all,

The attached patch enables the size= specifier in a READ statement to work with 
child DTIO procedures. This is accomplished by moving the size_used variable 
from the dtp structure to the gfc_unit structure so that the accumulation of 
bytes during READ is carried across the procedures via the UNIT.

As far as I know, this is the last DTIO patch needed for full implementation and 
will close the PR.

After this patch is committed I plan to prepare a clean up patch to reorganize 
the dtp structure and clear at least one TODO related to stream IO. The 
follow-on patch will bump the major version number of libgfortran to 4.

Regression tested on x86-64-linux. New test case attached.

OK for trunk?

Jerry

2016-10-17  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/48298
	* io/io.h: Move size_used from dtp to unit structure. Add bool
	has_size to unit structure.
	* read.c (read_x): Use has_size and size_used.
	* transfer.c (read_sf_internal): Likewise. (read_sf): Likewise.
	(read_block_form): Likewise. (read_block_form4): Likewise.
	(data_transfer_init): If parent, initialize the size variables.
	(finalize_transfer): Set the size variable using size_used in
	gfc_unit. (write_block): Delete bogus/dead code.



[-- Attachment #2: size.diff --]
[-- Type: text/x-patch, Size: 5295 bytes --]

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index bfda86df..f20c5106 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,15 @@
+2016-10-17  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/48298
+	* io/io.h: Move size_used from dtp to unit structure. Add bool
+	has_size to unit structure.
+	* read.c (read_x): Use has_size and size_used.
+	* transfer.c (read_sf_internal): Likewise. (read_sf): Likewise.
+	(read_block_form): Likewise. (read_block_form4): Likewise.
+	(data_transfer_init): If parent, initialize the size variables.
+	(finalize_transfer): Set the size variable using size_used in
+	gfc_unit. (write_block): Delete bogus/dead code.
+
 2016-10-16  Janne Blomqvist  <jb@gcc.gnu.org>
 
 	PR libfortran/48587
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index aaacc089..edc520a9 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -514,7 +514,6 @@ typedef struct st_parameter_dt
 	     large enough to hold a complex value (two reals) of the
 	     largest kind.  */
 	  char value[32];
-	  GFC_IO_INT size_used;
 	  formatted_dtio fdtio_ptr;
 	  unformatted_dtio ufdtio_ptr;
 	} p;
@@ -650,6 +649,8 @@ typedef struct gfc_unit
   /* DTIO Parent/Child procedure, 0 = parent, >0 = child level.  */
   int child_dtio;
   int last_char;
+  bool has_size;
+  GFC_IO_INT size_used;
 }
 gfc_unit;
 
diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c
index f8d5b72e..d72cdb37 100644
--- a/libgfortran/io/read.c
+++ b/libgfortran/io/read.c
@@ -1282,8 +1282,9 @@ read_x (st_parameter_dt *dtp, int n)
     } 
 
  done:
-  if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
-    dtp->u.p.size_used += (GFC_IO_INT) n;
+  if (((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) ||
+      dtp->u.p.current_unit->has_size)
+    dtp->u.p.current_unit->size_used += (GFC_IO_INT) n;
   dtp->u.p.current_unit->bytes_left -= n;
   dtp->u.p.current_unit->strm_pos += (gfc_offset) n;
 }
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 2232417a..e5805772 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -267,8 +267,9 @@ read_sf_internal (st_parameter_dt *dtp, int * length)
 
   dtp->u.p.current_unit->bytes_left -= *length;
 
-  if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
-    dtp->u.p.size_used += (GFC_IO_INT) *length;
+  if (((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) ||
+      dtp->u.p.current_unit->has_size)
+    dtp->u.p.current_unit->size_used += (GFC_IO_INT) *length;
 
   return base;
 
@@ -397,8 +398,9 @@ read_sf (st_parameter_dt *dtp, int * length)
 
   dtp->u.p.current_unit->bytes_left -= n;
 
-  if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
-    dtp->u.p.size_used += (GFC_IO_INT) n;
+  if (((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) ||
+      dtp->u.p.current_unit->has_size)
+    dtp->u.p.current_unit->size_used += (GFC_IO_INT) n;
 
   /* We can't call fbuf_getptr before the loop doing fbuf_getc, because
      fbuf_getc might reallocate the buffer.  So return current pointer
@@ -478,8 +480,9 @@ read_block_form (st_parameter_dt *dtp, int * nbytes)
   source = fbuf_read (dtp->u.p.current_unit, nbytes);
   fbuf_seek (dtp->u.p.current_unit, *nbytes, SEEK_CUR);
 
-  if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
-    dtp->u.p.size_used += (GFC_IO_INT) *nbytes;
+  if (((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) ||
+      dtp->u.p.current_unit->has_size)
+    dtp->u.p.current_unit->size_used += (GFC_IO_INT) *nbytes;
 
   if (norig != *nbytes)
     {
@@ -536,8 +539,9 @@ read_block_form4 (st_parameter_dt *dtp, int * nbytes)
 
   dtp->u.p.current_unit->bytes_left -= *nbytes;
 
-  if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
-    dtp->u.p.size_used += (GFC_IO_INT) *nbytes;
+  if (((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) ||
+      dtp->u.p.current_unit->has_size)
+    dtp->u.p.current_unit->size_used += (GFC_IO_INT) *nbytes;
 
   return source;
 }
@@ -770,9 +774,6 @@ write_block (st_parameter_dt *dtp, int length)
 	}
     }
 
-  if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
-    dtp->u.p.size_used += (GFC_IO_INT) length;
-
   dtp->u.p.current_unit->strm_pos += (gfc_offset) length;
 
   return dest;
@@ -2596,9 +2597,6 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
   if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK)
     return;
 
-  if ((cf & IOPARM_DT_HAS_SIZE) != 0)
-    dtp->u.p.size_used = 0;  /* Initialize the count.  */
-
   dtp->u.p.current_unit = get_unit (dtp, 1);
 
   if (dtp->u.p.current_unit == NULL)
@@ -2674,6 +2672,18 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
 	return;
     }
 
+  if (dtp->u.p.current_unit->child_dtio == 0)
+    {
+      if ((cf & IOPARM_DT_HAS_SIZE) != 0)
+	{
+	  dtp->u.p.current_unit->has_size = true;
+	  /* Initialize the count.  */
+	  dtp->u.p.current_unit->size_used = 0;
+	}
+      else
+	dtp->u.p.current_unit->has_size = false;
+    }
+
   /* Check the action.  */
 
   if (read_flag && dtp->u.p.current_unit->flags.action == ACTION_WRITE)
@@ -3772,7 +3782,7 @@ finalize_transfer (st_parameter_dt *dtp)
     return;
 
   if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
-    *dtp->size = dtp->u.p.size_used;
+    *dtp->size = dtp->u.p.current_unit->size_used;
 
   if (dtp->u.p.eor_condition)
     {



[-- Attachment #3: dtio_17.f90 --]
[-- Type: text/x-fortran, Size: 2184 bytes --]

! { dg-do run }
! PR48298, this tests function of size= specifier with DTIO.
MODULE p
  USE ISO_FORTRAN_ENV
  TYPE :: person
    CHARACTER (LEN=20) :: name
    INTEGER(4) :: age
    CONTAINS
      procedure :: pwf
      procedure :: prf
      GENERIC :: WRITE(FORMATTED) => pwf
      GENERIC :: READ(FORMATTED) => prf
  END TYPE person
CONTAINS
  SUBROUTINE pwf (dtv,unit,iotype,vlist,iostat,iomsg)
    CLASS(person), INTENT(IN) :: dtv
    INTEGER, INTENT(IN) :: unit
    CHARACTER (LEN=*), INTENT(IN) :: iotype
    INTEGER, INTENT(IN) :: vlist(:)
    INTEGER, INTENT(OUT) :: iostat
    CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
    CHARACTER (LEN=30) :: udfmt
    INTEGER :: myios

    iomsg = "SUCCESS"
    iostat=0
    if (iotype.eq."DT") then
      WRITE(unit, FMT = '(a20,i2)', IOSTAT=iostat, advance='no') dtv%name, dtv%age
      if (iostat.ne.0) iomsg = "Fail PWF DT"
    endif
    if (iotype.eq."LISTDIRECTED") then
      WRITE(unit, '(*(g0))', IOSTAT=iostat) dtv%name, dtv%age
      if (iostat.ne.0) iomsg = "Fail PWF DT"
    endif
  END SUBROUTINE pwf

  SUBROUTINE prf (dtv,unit,iotype,vlist,iostat,iomsg)
    CLASS(person), INTENT(INOUT) :: dtv
    INTEGER, INTENT(IN) :: unit
    CHARACTER (LEN=*), INTENT(IN) :: iotype
    INTEGER, INTENT(IN) :: vlist(:)
    INTEGER, INTENT(OUT) :: iostat
    CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
    CHARACTER (LEN=30) :: udfmt
    INTEGER :: myios
    real :: areal
    udfmt='(*(g0))'
    iomsg = "SUCCESS"
    iostat=0
    if (iotype.eq."DT") then
      READ(unit, FMT = '(a20,i2)', IOSTAT=iostat) dtv%name, dtv%age
      if (iostat.ne.0) iomsg = "Fail PWF DT"
    endif
  END SUBROUTINE prf

END MODULE p

PROGRAM test
  USE p
  implicit none
  TYPE (person) :: chairman
  integer(4) :: rl, tl, kl, thesize

  chairman%name="Charlie"
  chairman%age=62

  open(28, status='scratch')
  write(28, '(i10,i10,DT,i15,DT,i12)') rl, kl, chairman, rl, chairman, tl
  rewind(28)
  chairman%name="bogus"
  chairman%age=99
  !print *, chairman
  read(28, '(i10,i10,DT,i15,DT,i12)', advance='no', size=thesize) rl, &
                          & kl, chairman, rl, chairman, tl
  if (thesize.ne.91) call abort
  close(28)
END PROGRAM test



^ permalink raw reply	[flat|nested] 9+ messages in thread
end of thread, other threads:[~2016-10-19 18:48 UTC | newest]

Thread overview: 9+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2016-10-18  1:03 [patch, gfortran] PR48298 DTIO, implement size= Jerry DeLisle
2016-10-18  2:45 ` Steve Kargl
2016-10-19  8:59   ` Christophe Lyon
2016-10-19 14:55     ` Jerry DeLisle
2016-10-19 15:18       ` Andreas Schwab
2016-10-19 11:04 ` Andreas Schwab
2016-10-19 15:09   ` Jerry DeLisle
2016-10-19 15:20     ` Andreas Schwab
2016-10-19 18:48       ` Jerry DeLisle

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).