This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Patch,libgfortran] PR29053 Consecutive STREAM I/O file positions mixed up


:ADDPATCH Fortran:

In my first version of the STREAM I/O, I incorrectly assumed that the dtp->rec variable was static across multiple writes. This is not true, the dtp structure is strictly for passing parameters from the frontend to the I/O library.

This makes it necessary to have a variable within the gfc_unit structure to track the STREAM I/O position. The attached patch implements this by using a new variable, strm_pos, which is set to the dtp->rec value when it exists as determined by testing the appropriate bit in the common flags.

I am still testing to see if this resolves PR28747.

Regression tested on i686-linux-gnu.

OK to commit to 4.2?

2006-09-14 Jerry DeLisle <jvdelisle@gcc.gnu.org>

	PR libgfortran/29053
	* io.h (gfc_unit): Add variable, strm_pos, to track
	STREAM I/O file position.
	* file_pos.c (st_rewind): Set strm_pos to beginning.
	* open.c (new_unit): Initialize strm_pos.
	* read.c (read_x): Bump strm_pos.
	* inquire.c (inquire_via_unit): Return strm_pos value.
	* transfer.c (read_block),(read_block_direct),(write_block)
	(write_buf): Test for DT_HAS_REC and if so assign the POS=value to
	strm_pos.  Seek to strm_pos - 1.  Update strm_pos when done.
	(pre_position): Initialize strm_pos.
	(finalize_transfer): Flush file, no need to update strm_pos.

Index: io/file_pos.c
===================================================================
*** io/file_pos.c	(revision 116941)
--- io/file_pos.c	(working copy)
*************** st_rewind (st_parameter_filepos *fpp)
*** 312,317 ****
--- 312,318 ----
  	  u->endfile = NO_ENDFILE;
  	  u->current_record = 0;
  	  u->bytes_left = 0;
+ 	  u->strm_pos = 1;
  	  u->read_bad = 0;
  	  test_endfile (u);
  	}
Index: io/open.c
===================================================================
*** io/open.c	(revision 116941)
--- io/open.c	(working copy)
*************** new_unit (st_parameter_open *opp, gfc_un
*** 440,446 ****
      {
        u->maxrec = max_offset;
        u->recl = 1;
!       u->last_record = 1;
      }
  
    memmove (u->file, opp->file, opp->file_len);
--- 440,446 ----
      {
        u->maxrec = max_offset;
        u->recl = 1;
!       u->strm_pos = 1;
      }
  
    memmove (u->file, opp->file, opp->file_len);
Index: io/read.c
===================================================================
*** io/read.c	(revision 116941)
--- io/read.c	(working copy)
*************** read_x (st_parameter_dt *dtp, int n)
*** 853,857 ****
        dtp->u.p.sf_read_comma = 1;
      }
    else
!     dtp->rec += (GFC_IO_INT) n;
  }
--- 853,857 ----
        dtp->u.p.sf_read_comma = 1;
      }
    else
!     dtp->u.p.current_unit->strm_pos += (gfc_offset) n;
  }
Index: io/io.h
===================================================================
*** io/io.h	(revision 116941)
--- io/io.h	(working copy)
*************** typedef struct gfc_unit
*** 498,505 ****
    /* recl           -- Record length of the file.
       last_record    -- Last record number read or written
       maxrec         -- Maximum record number in a direct access file
!      bytes_left     -- Bytes left in current record.  */
!   gfc_offset recl, last_record, maxrec, bytes_left;
  
    __gthread_mutex_t lock;
    /* Number of threads waiting to acquire this unit's lock.
--- 498,506 ----
    /* recl           -- Record length of the file.
       last_record    -- Last record number read or written
       maxrec         -- Maximum record number in a direct access file
!      bytes_left     -- Bytes left in current record.
!      strm_pos       -- Current position in file for STREAM I/O.  */
!   gfc_offset recl, last_record, maxrec, bytes_left, strm_pos;
  
    __gthread_mutex_t lock;
    /* Number of threads waiting to acquire this unit's lock.
Index: io/inquire.c
===================================================================
*** io/inquire.c	(revision 116941)
--- io/inquire.c	(working copy)
*************** inquire_via_unit (st_parameter_inquire *
*** 149,155 ****
      *iqp->recl_out = (u != NULL) ? u->recl : 0;
  
    if ((cf & IOPARM_INQUIRE_HAS_STRM_POS_OUT) != 0)
!     *iqp->strm_pos_out = (u != NULL) ? u->last_record : 0;
  
    if ((cf & IOPARM_INQUIRE_HAS_NEXTREC) != 0)
      *iqp->nextrec = (u != NULL) ? u->last_record + 1 : 0;
--- 149,155 ----
      *iqp->recl_out = (u != NULL) ? u->recl : 0;
  
    if ((cf & IOPARM_INQUIRE_HAS_STRM_POS_OUT) != 0)
!     *iqp->strm_pos_out = (u != NULL) ? u->strm_pos : 0;
  
    if ((cf & IOPARM_INQUIRE_HAS_NEXTREC) != 0)
      *iqp->nextrec = (u != NULL) ? u->last_record + 1 : 0;
Index: io/transfer.c
===================================================================
*** io/transfer.c	(revision 116941)
--- io/transfer.c	(working copy)
*************** read_block (st_parameter_dt *dtp, int *l
*** 317,324 ****
      }
    else
      {
        if (sseek (dtp->u.p.current_unit->s,
! 		 (gfc_offset) (dtp->rec - 1)) == FAILURE)
  	{
  	  generate_error (&dtp->common, ERROR_END, NULL);
  	  return NULL;
--- 317,327 ----
      }
    else
      {
+       if ((dtp->common.flags & IOPARM_DT_HAS_REC) != 0)
+ 	dtp->u.p.current_unit->strm_pos = dtp->rec;
+ 
        if (sseek (dtp->u.p.current_unit->s,
! 		 dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
  	{
  	  generate_error (&dtp->common, ERROR_END, NULL);
  	  return NULL;
*************** read_block (st_parameter_dt *dtp, int *l
*** 341,347 ****
  	    }
  	}
  
!       dtp->rec += (GFC_IO_INT) nread;
      }
    return source;
  }
--- 344,350 ----
  	    }
  	}
  
!       dtp->u.p.current_unit->strm_pos += (gfc_offset) nread;
      }
    return source;
  }
*************** read_block_direct (st_parameter_dt *dtp,
*** 399,406 ****
      }
    else
      {
        if (sseek (dtp->u.p.current_unit->s,
! 	  (gfc_offset) (dtp->rec - 1)) == FAILURE)
  	{
  	  generate_error (&dtp->common, ERROR_END, NULL);
  	  return;
--- 402,412 ----
      }
    else
      {
+       if ((dtp->common.flags & IOPARM_DT_HAS_REC) != 0)
+ 	dtp->u.p.current_unit->strm_pos = dtp->rec;
+ 
        if (sseek (dtp->u.p.current_unit->s,
! 		 dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
  	{
  	  generate_error (&dtp->common, ERROR_END, NULL);
  	  return;
*************** read_block_direct (st_parameter_dt *dtp,
*** 420,426 ****
  	dtp->u.p.size_used += (gfc_offset) nread;
      }
    else
!     dtp->rec += (GFC_IO_INT) nread; 
  
    if (nread != *nbytes)  /* Short read, e.g. if we hit EOF.  */
      {
--- 426,432 ----
  	dtp->u.p.size_used += (gfc_offset) nread;
      }
    else
!     dtp->u.p.current_unit->strm_pos += (gfc_offset) nread; 
  
    if (nread != *nbytes)  /* Short read, e.g. if we hit EOF.  */
      {
*************** write_block (st_parameter_dt *dtp, int l
*** 478,485 ****
      }
    else
      {
        if (sseek (dtp->u.p.current_unit->s,
! 	  (gfc_offset) (dtp->rec - 1)) == FAILURE)
  	{
  	  generate_error (&dtp->common, ERROR_END, NULL);
  	  return NULL;
--- 484,494 ----
      }
    else
      {
+       if ((dtp->common.flags & IOPARM_DT_HAS_REC) != 0)
+ 	dtp->u.p.current_unit->strm_pos = dtp->rec;
+ 
        if (sseek (dtp->u.p.current_unit->s,
! 		 dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
  	{
  	  generate_error (&dtp->common, ERROR_END, NULL);
  	  return NULL;
*************** write_block (st_parameter_dt *dtp, int l
*** 493,499 ****
  	  return NULL;
  	}
  
!       dtp->rec += (GFC_IO_INT) length;
      }
  
    return dest;
--- 502,508 ----
  	  return NULL;
  	}
  
!       dtp->u.p.current_unit->strm_pos += (gfc_offset) length;
      }
  
    return dest;
*************** write_buf (st_parameter_dt *dtp, void *b
*** 530,537 ****
      }
    else
      {
        if (sseek (dtp->u.p.current_unit->s,
! 		 (gfc_offset) (dtp->rec - 1)) == FAILURE)
  	{
  	  generate_error (&dtp->common, ERROR_OS, NULL);
  	  return FAILURE;
--- 539,549 ----
      }
    else
      {
+       if ((dtp->common.flags & IOPARM_DT_HAS_REC) != 0)
+ 	dtp->u.p.current_unit->strm_pos = dtp->rec;
+ 
        if (sseek (dtp->u.p.current_unit->s,
! 		 dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
  	{
  	  generate_error (&dtp->common, ERROR_OS, NULL);
  	  return FAILURE;
*************** write_buf (st_parameter_dt *dtp, void *b
*** 550,556 ****
  	dtp->u.p.size_used += (gfc_offset) nbytes;
      }
    else
!     dtp->rec += (GFC_IO_INT) nbytes; 
  
    return SUCCESS;
  }
--- 562,568 ----
  	dtp->u.p.size_used += (gfc_offset) nbytes;
      }
    else
!     dtp->u.p.current_unit->strm_pos += (gfc_offset) nbytes; 
  
    return SUCCESS;
  }
*************** pre_position (st_parameter_dt *dtp)
*** 1506,1512 ****
        /* There are no records with stream I/O.  Set the default position
  	 to the beginning of the file if no position was specified.  */
        if ((dtp->common.flags & IOPARM_DT_HAS_REC) == 0)
!         dtp->rec = 1;
        break;
      
      case UNFORMATTED_SEQUENTIAL:
--- 1518,1524 ----
        /* There are no records with stream I/O.  Set the default position
  	 to the beginning of the file if no position was specified.  */
        if ((dtp->common.flags & IOPARM_DT_HAS_REC) == 0)
!         dtp->u.p.current_unit->strm_pos = 1;
        break;
      
      case UNFORMATTED_SEQUENTIAL:
*************** finalize_transfer (st_parameter_dt *dtp)
*** 2367,2376 ****
        next_record (dtp, 1);
      }
    else
!     {
!       flush (dtp->u.p.current_unit->s);
!       dtp->u.p.current_unit->last_record = dtp->rec;
!     }
  
    sfree (dtp->u.p.current_unit->s);
  }
--- 2379,2385 ----
        next_record (dtp, 1);
      }
    else
!     flush (dtp->u.p.current_unit->s);
  
    sfree (dtp->u.p.current_unit->s);
  }
! { dg-do run }
! PR29053 Stream IO test 9.
! Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
! Test case derived from that given in PR by Steve Kargl.
program pr29053
   implicit none
   real dt, t, u, a(10), b(10)
   integer i, place
   dt = 1.e-6
   a = real( (/ (i, i=1, 10) /) )
   b = a
   open(unit=11, file='a.dat', access='stream')
   open(unit=12, file='b.dat', access='stream')
   do i = 1, 10
      t = i * dt
      write(11) t
      write(12) a
   end do
   rewind(11)
   rewind(12)
   do i = 1, 10
      t = i * dt
      read(12) a
      if (any(a.ne.b)) print *, "a failed"
      read(11) u
      if (u.ne.t) print *, "t failed"
   end do
   close(11, status="delete")
   close(12, status="delete")
end program pr29053


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]