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]

Re: [patch,fortran] PR25828 F2003 Stream I/O


:ADDPATCH fortran:

The attached patch is the final version of the stream IO patch. Ready to commit to 4.2 if approved. This patch includes the INQUIRE (pos= ) capability. It also incorporates the casts in transfer.c to eliminate warnings that Jack was seeing.

The streamio_7.f90 test was revised to not use an empty write to position the file. Though this seems to work on most systems, it does not seem to work on 64 bit platforms. Steve Kargl and I have been beating on that one for about a week and have decided to open a separate PR for this, since it is a corner case.

streamio_8.f90 is added to test the INQUIRE function.

I also took the opportunity, since I had to add a new pointer type for GFC_LARGE_IO_INTEGER, to shorten that to GFC_IO_INT. This makes sense since on systems that do not support large file IO, it is not a LARGE_IO integer.

For consistency, I reordered the ioparm flags. Maybe not necessary, but looks cleaner.

Regression tested OK. OK to commit to 4.2 only?

If we do this now we won't have to back port it later, it appears safe, and we should not need to bump the rev on the library.

Regards,

Jerry

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

	PR libgfortran/25828
	* libgfortran.h: Rename GFC_LARGE_IO_INT to GFC_IO_INT.
	* io/file_pos.c (st_backspace): Ignore if access=STREAM.
	(st_rewind): Handle case of access=STREAM.
	* io/open.c (access_opt): Add STREAM_ACCESS.
	(edit_modes): Set current_record to zero only if not STREAM.
	(new_unit): Initialize maxrec, recl, and last_record for STREAM.
	* io/read.c (read_x): Advance file position for STREAM.
	* io/io.h (enum unit_access): Align IOPARM flags with frontend.
	Add ACCESS_STREAM. Add prototype for is_stream_io () function.
	Use GFC_IO_INT.
	* io/inquire.c (inquire_via_unit): Add text for access = "STREAM".
	* io/unit.c (is_stream_io): New function to return true if access =
	STREAM.
	* io/transfer.c (file_mode): Add modes for unformatted stream and
	formatted stream. (current_mode): Return appropriate file mode based
	on access flags.
	(read_block): Handle formatted stream reads.
	(read_block_direct): Handle unformatted stream reads.
	(write_block): Handle formatted stream writes.
	(write_buf): Handle unformatted stream writes.
	(unformatted_read): Fix up, use temporary for size.
	(pre_position): Position file for STREAM access.
	(data_transfer_init): Initialize for stream access, skip irrelevent
	error checks.
	(next_record_r),(next_record_w), and (next_record): Do nothing for
	stream I/O.
	(finalize_transfer): Flush when all done if stream I/O.

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

	PR fortran/25828
	* gfortran.h: Add new pointer for stream position to st_inquire.
	Rename gfc_large_io_int_kind to gfc_intio_kind.
	* trans-types.c (gfc_init_kinds): use gfc_intio_kind.
	* io.c: Add new IO tag for file position going in and another for out.
	(match_dt_element): Match new tag_spos.
	(gfc_resolve_dt): Resolve new tag_spos.
	(gfc_free_inquire): Free inquire->strm_pos.
	(match_inquire_element): Match new tag_strm_out.
	(gfc_resolve_inquire): Resolve new tag_strm_out.
	* trans-io.c: Rename IOPARM_type_large_io_int to IOPARM_type_intio.
	(gfc_build_st_parameter): Same.
	(gfc_build_io_library_fndecls) Same. and add build pointer type pintio.
	(gfc_trans_inquire): Translate strm_pos for inquire.
	* ioparm.def: Reorder flags to accomodate addition of new inquire
	flag for strm_pos_out and add it in.



Index: gcc/fortran/gfortran.h
===================================================================
*** gcc/fortran/gfortran.h	(revision 116057)
--- gcc/fortran/gfortran.h	(working copy)
*************** typedef struct
*** 1465,1471 ****
    gfc_expr *unit, *file, *iostat, *exist, *opened, *number, *named,
      *name, *access, *sequential, *direct, *form, *formatted,
      *unformatted, *recl, *nextrec, *blank, *position, *action, *read,
!     *write, *readwrite, *delim, *pad, *iolength, *iomsg, *convert;
  
    gfc_st_label *err;
  
--- 1465,1471 ----
    gfc_expr *unit, *file, *iostat, *exist, *opened, *number, *named,
      *name, *access, *sequential, *direct, *form, *formatted,
      *unformatted, *recl, *nextrec, *blank, *position, *action, *read,
!     *write, *readwrite, *delim, *pad, *iolength, *iomsg, *convert, *strm_pos;
  
    gfc_st_label *err;
  
*************** extern int gfc_default_character_kind;
*** 1816,1822 ****
  extern int gfc_default_logical_kind;
  extern int gfc_default_complex_kind;
  extern int gfc_c_int_kind;
! extern int gfc_large_io_int_kind;
  
  /* symbol.c */
  void gfc_clear_new_implicit (void);
--- 1816,1822 ----
  extern int gfc_default_logical_kind;
  extern int gfc_default_complex_kind;
  extern int gfc_c_int_kind;
! extern int gfc_intio_kind;
  
  /* symbol.c */
  void gfc_clear_new_implicit (void);
Index: gcc/fortran/trans-types.c
===================================================================
*** gcc/fortran/trans-types.c	(revision 116057)
--- gcc/fortran/trans-types.c	(working copy)
*************** int gfc_c_int_kind;
*** 95,101 ****
  
  /* The kind size used for record offsets. If the target system supports
     kind=8, this will be set to 8, otherwise it is set to 4.  */
! int gfc_large_io_int_kind; 
  
  /* Query the target to determine which machine modes are available for
     computation.  Choose KIND numbers for them.  */
--- 95,101 ----
  
  /* The kind size used for record offsets. If the target system supports
     kind=8, this will be set to 8, otherwise it is set to 4.  */
! int gfc_intio_kind; 
  
  /* Query the target to determine which machine modes are available for
     computation.  Choose KIND numbers for them.  */
*************** gfc_init_kinds (void)
*** 144,156 ****
        i_index += 1;
      }
  
!   /* Set the kind used to match GFC_LARGE_IO_INT in libgfortran.  This is 
       used for large file access.  */
  
    if (saw_i8)
!     gfc_large_io_int_kind = 8;
    else
!     gfc_large_io_int_kind = 4;
  
    /* If we do not at least have kind = 4, everything is pointless.  */  
    gcc_assert(saw_i4);  
--- 144,156 ----
        i_index += 1;
      }
  
!   /* Set the kind used to match GFC_INT_IO in libgfortran.  This is 
       used for large file access.  */
  
    if (saw_i8)
!     gfc_intio_kind = 8;
    else
!     gfc_intio_kind = 4;
  
    /* If we do not at least have kind = 4, everything is pointless.  */  
    gcc_assert(saw_i4);  
Index: gcc/fortran/io.c
===================================================================
*** gcc/fortran/io.c	(revision 116057)
--- gcc/fortran/io.c	(working copy)
*************** static const io_tag
*** 52,57 ****
--- 52,58 ----
  	tag_unit	= {"UNIT", " unit = %e", BT_INTEGER},
  	tag_advance	= {"ADVANCE", " advance = %e", BT_CHARACTER},
  	tag_rec		= {"REC", " rec = %e", BT_INTEGER},
+ 	tag_spos        = {"POSITION", " pos = %e", BT_INTEGER},
  	tag_format	= {"FORMAT", NULL, BT_CHARACTER},
  	tag_iomsg	= {"IOMSG", " iomsg = %e", BT_CHARACTER},
  	tag_iostat	= {"IOSTAT", " iostat = %v", BT_INTEGER},
*************** static const io_tag
*** 79,84 ****
--- 80,86 ----
  	tag_s_pad	= {"PAD", " pad = %v", BT_CHARACTER},
  	tag_iolength	= {"IOLENGTH", " iolength = %v", BT_INTEGER},
  	tag_convert     = {"CONVERT", " convert = %e", BT_CHARACTER},
+ 	tag_strm_out    = {"POS", " pos = %v", BT_INTEGER},
  	tag_err		= {"ERR", " err = %l", BT_UNKNOWN},
  	tag_end		= {"END", " end = %l", BT_UNKNOWN},
  	tag_eor		= {"EOR", " eor = %l", BT_UNKNOWN};
*************** match_dt_element (io_kind k, gfc_dt * dt
*** 1784,1789 ****
--- 1786,1794 ----
    m = match_etag (&tag_rec, &dt->rec);
    if (m != MATCH_NO)
      return m;
+   m = match_etag (&tag_spos, &dt->rec);
+   if (m != MATCH_NO)
+     return m;
    m = match_out_tag (&tag_iomsg, &dt->iomsg);
    if (m != MATCH_NO)
      return m;
*************** gfc_resolve_dt (gfc_dt * dt)
*** 1855,1860 ****
--- 1860,1866 ----
  
    RESOLVE_TAG (&tag_format, dt->format_expr);
    RESOLVE_TAG (&tag_rec, dt->rec);
+   RESOLVE_TAG (&tag_spos, dt->rec);
    RESOLVE_TAG (&tag_advance, dt->advance);
    RESOLVE_TAG (&tag_iomsg, dt->iomsg);
    RESOLVE_TAG (&tag_iostat, dt->iostat);
*************** gfc_free_inquire (gfc_inquire * inquire)
*** 2643,2648 ****
--- 2649,2655 ----
    gfc_free_expr (inquire->pad);
    gfc_free_expr (inquire->iolength);
    gfc_free_expr (inquire->convert);
+   gfc_free_expr (inquire->strm_pos);
  
    gfc_free (inquire);
  }
*************** match_inquire_element (gfc_inquire * inq
*** 2685,2690 ****
--- 2692,2698 ----
    RETM m = match_vtag (&tag_s_pad, &inquire->pad);
    RETM m = match_vtag (&tag_iolength, &inquire->iolength);
    RETM m = match_vtag (&tag_convert, &inquire->convert);
+   RETM m = match_out_tag (&tag_strm_out, &inquire->strm_pos);
    RETM return MATCH_NO;
  }
  
*************** gfc_resolve_inquire (gfc_inquire * inqui
*** 2839,2844 ****
--- 2847,2853 ----
    RESOLVE_TAG (&tag_s_pad, inquire->pad);
    RESOLVE_TAG (&tag_iolength, inquire->iolength);
    RESOLVE_TAG (&tag_convert, inquire->convert);
+   RESOLVE_TAG (&tag_strm_out, inquire->strm_pos);
  
    if (gfc_reference_st_label (inquire->err, ST_LABEL_TARGET) == FAILURE)
      return FAILURE;
Index: gcc/fortran/trans-io.c
===================================================================
*** gcc/fortran/trans-io.c	(revision 116057)
--- gcc/fortran/trans-io.c	(working copy)
*************** Software Foundation, 51 Franklin Street,
*** 35,41 ****
  #include "trans-types.h"
  #include "trans-const.h"
  
- 
  /* Members of the ioparm structure.  */
  
  enum ioparam_type
--- 35,40 ----
*************** enum ioparam_type
*** 52,59 ****
  enum iofield_type
  {
    IOPARM_type_int4,
!   IOPARM_type_large_io_int,
    IOPARM_type_pint4,
    IOPARM_type_pchar,
    IOPARM_type_parray,
    IOPARM_type_pad,
--- 51,59 ----
  enum iofield_type
  {
    IOPARM_type_int4,
!   IOPARM_type_intio,
    IOPARM_type_pint4,
+   IOPARM_type_pintio,
    IOPARM_type_pchar,
    IOPARM_type_parray,
    IOPARM_type_pad,
*************** gfc_build_st_parameter (enum ioparam_typ
*** 169,176 ****
        switch (p->type)
  	{
  	case IOPARM_type_int4:
! 	case IOPARM_type_large_io_int:
  	case IOPARM_type_pint4:
  	case IOPARM_type_parray:
  	case IOPARM_type_pchar:
  	case IOPARM_type_pad:
--- 169,177 ----
        switch (p->type)
  	{
  	case IOPARM_type_int4:
! 	case IOPARM_type_intio:
  	case IOPARM_type_pint4:
+ 	case IOPARM_type_pintio:
  	case IOPARM_type_parray:
  	case IOPARM_type_pchar:
  	case IOPARM_type_pad:
*************** void
*** 216,231 ****
  gfc_build_io_library_fndecls (void)
  {
    tree types[IOPARM_type_num], pad_idx, gfc_int4_type_node;
!   tree gfc_large_io_int_type_node;
    tree parm_type, dt_parm_type;
    tree gfc_c_int_type_node;
    HOST_WIDE_INT pad_size;
    enum ioparam_type ptype;
  
    types[IOPARM_type_int4] = gfc_int4_type_node = gfc_get_int_type (4);
!   types[IOPARM_type_large_io_int] = gfc_large_io_int_type_node
! 			    = gfc_get_int_type (gfc_large_io_int_kind);
    types[IOPARM_type_pint4] = build_pointer_type (gfc_int4_type_node);
    types[IOPARM_type_parray] = pchar_type_node;
    types[IOPARM_type_pchar] = pchar_type_node;
    pad_size = 16 * TREE_INT_CST_LOW (TYPE_SIZE_UNIT (pchar_type_node));
--- 217,234 ----
  gfc_build_io_library_fndecls (void)
  {
    tree types[IOPARM_type_num], pad_idx, gfc_int4_type_node;
!   tree gfc_intio_type_node;
    tree parm_type, dt_parm_type;
    tree gfc_c_int_type_node;
    HOST_WIDE_INT pad_size;
    enum ioparam_type ptype;
  
    types[IOPARM_type_int4] = gfc_int4_type_node = gfc_get_int_type (4);
!   types[IOPARM_type_intio] = gfc_intio_type_node
! 			    = gfc_get_int_type (gfc_intio_kind);
    types[IOPARM_type_pint4] = build_pointer_type (gfc_int4_type_node);
+   types[IOPARM_type_pintio]
+ 			    = build_pointer_type (gfc_intio_type_node);
    types[IOPARM_type_parray] = pchar_type_node;
    types[IOPARM_type_pchar] = pchar_type_node;
    pad_size = 16 * TREE_INT_CST_LOW (TYPE_SIZE_UNIT (pchar_type_node));
*************** gfc_trans_inquire (gfc_code * code)
*** 1098,1103 ****
--- 1101,1110 ----
      mask |= set_string (&block, &post_block, var, IOPARM_inquire_convert,
  			p->convert);
  
+   if (p->strm_pos)
+     mask |= set_parameter_ref (&block, &post_block, var,
+ 			       IOPARM_inquire_strm_pos_out, p->strm_pos);
+ 
    set_parameter_const (&block, var, IOPARM_common_flags, mask);
  
    tmp = build_fold_addr_expr (var);
Index: gcc/fortran/ioparm.def
===================================================================
*** gcc/fortran/ioparm.def	(revision 116057)
--- gcc/fortran/ioparm.def	(working copy)
*************** IOPARM (inquire, number,	1 << 9,  pint4)
*** 36,64 ****
  IOPARM (inquire, named,		1 << 10, pint4)
  IOPARM (inquire, nextrec,	1 << 11, pint4)
  IOPARM (inquire, recl_out,	1 << 12, pint4)
! IOPARM (inquire, file,		1 << 13, char1)
! IOPARM (inquire, access,	1 << 14, char2)
! IOPARM (inquire, form,		1 << 15, char1)
! IOPARM (inquire, blank,		1 << 16, char2)
! IOPARM (inquire, position,	1 << 17, char1)
! IOPARM (inquire, action,	1 << 18, char2)
! IOPARM (inquire, delim,		1 << 19, char1)
! IOPARM (inquire, pad,		1 << 20, char2)
! IOPARM (inquire, name,		1 << 21, char1)
! IOPARM (inquire, sequential,	1 << 22, char2)
! IOPARM (inquire, direct,	1 << 23, char1)
! IOPARM (inquire, formatted,	1 << 24, char2)
! IOPARM (inquire, unformatted,	1 << 25, char1)
! IOPARM (inquire, read,		1 << 26, char2)
! IOPARM (inquire, write,		1 << 27, char1)
! IOPARM (inquire, readwrite,	1 << 28, char2)
! IOPARM (inquire, convert,       1 << 29, char1)
  #ifndef IOPARM_dt_list_format
  #define IOPARM_dt_list_format		(1 << 7)
  #define IOPARM_dt_namelist_read_mode	(1 << 8)
  #endif
  IOPARM (dt,      common,	0,	 common)
! IOPARM (dt,      rec,		1 << 9,  large_io_int)
  IOPARM (dt,      size,		1 << 10, pint4)
  IOPARM (dt,      iolength,	1 << 11, pint4)
  IOPARM (dt,      internal_unit_desc, 0,  parray)
--- 36,65 ----
  IOPARM (inquire, named,		1 << 10, pint4)
  IOPARM (inquire, nextrec,	1 << 11, pint4)
  IOPARM (inquire, recl_out,	1 << 12, pint4)
! IOPARM (inquire, strm_pos_out,	1 << 13, pintio)
! IOPARM (inquire, file,		1 << 14, char1)
! IOPARM (inquire, access,	1 << 15, char2)
! IOPARM (inquire, form,		1 << 16, char1)
! IOPARM (inquire, blank,		1 << 17, char2)
! IOPARM (inquire, position,	1 << 18, char1)
! IOPARM (inquire, action,	1 << 19, char2)
! IOPARM (inquire, delim,		1 << 20, char1)
! IOPARM (inquire, pad,		1 << 21, char2)
! IOPARM (inquire, name,		1 << 22, char1)
! IOPARM (inquire, sequential,	1 << 23, char2)
! IOPARM (inquire, direct,	1 << 24, char1)
! IOPARM (inquire, formatted,	1 << 25, char2)
! IOPARM (inquire, unformatted,	1 << 26, char1)
! IOPARM (inquire, read,		1 << 27, char2)
! IOPARM (inquire, write,		1 << 28, char1)
! IOPARM (inquire, readwrite,	1 << 29, char2)
! IOPARM (inquire, convert,       1 << 30, char1)
  #ifndef IOPARM_dt_list_format
  #define IOPARM_dt_list_format		(1 << 7)
  #define IOPARM_dt_namelist_read_mode	(1 << 8)
  #endif
  IOPARM (dt,      common,	0,	 common)
! IOPARM (dt,      rec,		1 << 9,  intio)
  IOPARM (dt,      size,		1 << 10, pint4)
  IOPARM (dt,      iolength,	1 << 11, pint4)
  IOPARM (dt,      internal_unit_desc, 0,  parray)
Index: libgfortran/libgfortran.h
===================================================================
*** libgfortran/libgfortran.h	(revision 116057)
--- libgfortran/libgfortran.h	(working copy)
*************** typedef off_t gfc_offset;
*** 200,209 ****
  /* Define the type used for the current record number for large file I/O.
     The size must be consistent with the size defined on the compiler side.  */
  #ifdef HAVE_GFC_INTEGER_8
! typedef GFC_INTEGER_8 GFC_LARGE_IO_INT;
  #else
  #ifdef HAVE_GFC_INTEGER_4
! typedef GFC_INTEGER_4 GFC_LARGE_IO_INT;
  #else
  #error "GFC_INTEGER_4 should be available for the library to compile".
  #endif
--- 200,209 ----
  /* Define the type used for the current record number for large file I/O.
     The size must be consistent with the size defined on the compiler side.  */
  #ifdef HAVE_GFC_INTEGER_8
! typedef GFC_INTEGER_8 GFC_IO_INT;
  #else
  #ifdef HAVE_GFC_INTEGER_4
! typedef GFC_INTEGER_4 GFC_IO_INT;
  #else
  #error "GFC_INTEGER_4 should be available for the library to compile".
  #endif
Index: libgfortran/io/file_pos.c
===================================================================
*** libgfortran/io/file_pos.c	(revision 116057)
--- libgfortran/io/file_pos.c	(working copy)
*************** st_backspace (st_parameter_filepos *fpp)
*** 205,211 ****
       sequential I/O and the next direct access transfer repositions the file 
       anyway.  */
  
!   if (u->flags.access == ACCESS_DIRECT)
      goto done;
  
    /* Check for special cases involving the ENDFILE record first.  */
--- 205,211 ----
       sequential I/O and the next direct access transfer repositions the file 
       anyway.  */
  
!   if (u->flags.access == ACCESS_DIRECT || u->flags.access == ACCESS_STREAM)
      goto done;
  
    /* Check for special cases involving the ENDFILE record first.  */
*************** st_rewind (st_parameter_filepos *fpp)
*** 291,297 ****
    u = find_unit (fpp->common.unit);
    if (u != NULL)
      {
!       if (u->flags.access != ACCESS_SEQUENTIAL)
  	generate_error (&fpp->common, ERROR_BAD_OPTION,
  			"Cannot REWIND a file opened for DIRECT access");
        else
--- 291,297 ----
    u = find_unit (fpp->common.unit);
    if (u != NULL)
      {
!       if (u->flags.access == ACCESS_DIRECT)
  	generate_error (&fpp->common, ERROR_BAD_OPTION,
  			"Cannot REWIND a file opened for DIRECT access");
        else
*************** st_rewind (st_parameter_filepos *fpp)
*** 301,307 ****
  	       file now.  Reset to read mode so two consecutive rewind
  	       statements do not delete the file contents.  */
  	  flush (u->s);
! 	  if (u->mode == WRITING)
  	    struncate (u->s);
  
  	  u->mode = READING;
--- 301,307 ----
  	       file now.  Reset to read mode so two consecutive rewind
  	       statements do not delete the file contents.  */
  	  flush (u->s);
! 	  if (u->mode == WRITING && u->flags.access != ACCESS_STREAM)
  	    struncate (u->s);
  
  	  u->mode = READING;
Index: libgfortran/io/open.c
===================================================================
*** libgfortran/io/open.c	(revision 116057)
--- libgfortran/io/open.c	(working copy)
*************** static const st_option access_opt[] = {
*** 40,45 ****
--- 40,46 ----
    {"sequential", ACCESS_SEQUENTIAL},
    {"direct", ACCESS_DIRECT},
    {"append", ACCESS_APPEND},
+   {"stream", ACCESS_STREAM},
    {NULL, 0}
  };
  
*************** edit_modes (st_parameter_open *opp, gfc_
*** 214,220 ****
        if (sseek (u->s, file_length (u->s)) == FAILURE)
  	goto seek_error;
  
!       u->current_record = 0;
        u->endfile = AT_ENDFILE;	/* We are at the end.  */
        break;
  
--- 215,223 ----
        if (sseek (u->s, file_length (u->s)) == FAILURE)
  	goto seek_error;
  
!       if (flags->access != ACCESS_STREAM)
! 	u->current_record = 0;
! 
        u->endfile = AT_ENDFILE;	/* We are at the end.  */
        break;
  
*************** new_unit (st_parameter_open *opp, gfc_un
*** 432,437 ****
--- 435,447 ----
  
    if (flags->access == ACCESS_DIRECT)
      u->maxrec = max_offset / u->recl;
+   
+   if (flags->access == ACCESS_STREAM)
+     {
+       u->maxrec = max_offset;
+       u->recl = 1;
+       u->last_record = 1;
+     }
  
    memmove (u->file, opp->file, opp->file_len);
    u->file_len = opp->file_len;
Index: libgfortran/io/read.c
===================================================================
*** libgfortran/io/read.c	(revision 116057)
--- libgfortran/io/read.c	(working copy)
*************** read_f (st_parameter_dt *dtp, const fnod
*** 841,853 ****
  void
  read_x (st_parameter_dt *dtp, int n)
  {
!   if ((dtp->u.p.current_unit->flags.pad == PAD_NO || is_internal_unit (dtp))
!       && dtp->u.p.current_unit->bytes_left < n)
!     n = dtp->u.p.current_unit->bytes_left;
! 
!   dtp->u.p.sf_read_comma = 0;
!   if (n > 0)
!     read_sf (dtp, &n, 1);
!   dtp->u.p.sf_read_comma = 1;
  
  }
--- 841,857 ----
  void
  read_x (st_parameter_dt *dtp, int n)
  {
!   if (!is_stream_io (dtp))
!     {
!       if ((dtp->u.p.current_unit->flags.pad == PAD_NO || is_internal_unit (dtp))
! 	  && dtp->u.p.current_unit->bytes_left < n)
! 	n = dtp->u.p.current_unit->bytes_left;
  
+       dtp->u.p.sf_read_comma = 0;
+       if (n > 0)
+ 	read_sf (dtp, &n, 1);
+       dtp->u.p.sf_read_comma = 1;
+     }
+   else
+     dtp->rec += (GFC_IO_INT) n;
  }
Index: libgfortran/io/io.h
===================================================================
*** libgfortran/io/io.h	(revision 116057)
--- libgfortran/io/io.h	(working copy)
*************** namelist_info;
*** 156,162 ****
  /* Options for the OPEN statement.  */
  
  typedef enum
! { ACCESS_SEQUENTIAL, ACCESS_DIRECT, ACCESS_APPEND,
    ACCESS_UNSPECIFIED
  }
  unit_access;
--- 156,162 ----
  /* Options for the OPEN statement.  */
  
  typedef enum
! { ACCESS_SEQUENTIAL, ACCESS_DIRECT, ACCESS_APPEND, ACCESS_STREAM,
    ACCESS_UNSPECIFIED
  }
  unit_access;
*************** st_parameter_filepos;
*** 290,318 ****
  #define IOPARM_INQUIRE_HAS_NAMED	(1 << 10)
  #define IOPARM_INQUIRE_HAS_NEXTREC	(1 << 11)
  #define IOPARM_INQUIRE_HAS_RECL_OUT	(1 << 12)
! #define IOPARM_INQUIRE_HAS_FILE		(1 << 13)
! #define IOPARM_INQUIRE_HAS_ACCESS	(1 << 14)
! #define IOPARM_INQUIRE_HAS_FORM		(1 << 15)
! #define IOPARM_INQUIRE_HAS_BLANK	(1 << 16)
! #define IOPARM_INQUIRE_HAS_POSITION	(1 << 17)
! #define IOPARM_INQUIRE_HAS_ACTION	(1 << 18)
! #define IOPARM_INQUIRE_HAS_DELIM	(1 << 19)
! #define IOPARM_INQUIRE_HAS_PAD		(1 << 20)
! #define IOPARM_INQUIRE_HAS_NAME		(1 << 21)
! #define IOPARM_INQUIRE_HAS_SEQUENTIAL	(1 << 22)
! #define IOPARM_INQUIRE_HAS_DIRECT	(1 << 23)
! #define IOPARM_INQUIRE_HAS_FORMATTED	(1 << 24)
! #define IOPARM_INQUIRE_HAS_UNFORMATTED	(1 << 25)
! #define IOPARM_INQUIRE_HAS_READ		(1 << 26)
! #define IOPARM_INQUIRE_HAS_WRITE	(1 << 27)
! #define IOPARM_INQUIRE_HAS_READWRITE	(1 << 28)
! #define IOPARM_INQUIRE_HAS_CONVERT	(1 << 29)
  
  typedef struct
  {
    st_parameter_common common;
    GFC_INTEGER_4 *exist, *opened, *number, *named;
    GFC_INTEGER_4 *nextrec, *recl_out;
    CHARACTER1 (file);
    CHARACTER2 (access);
    CHARACTER1 (form);
--- 290,320 ----
  #define IOPARM_INQUIRE_HAS_NAMED	(1 << 10)
  #define IOPARM_INQUIRE_HAS_NEXTREC	(1 << 11)
  #define IOPARM_INQUIRE_HAS_RECL_OUT	(1 << 12)
! #define IOPARM_INQUIRE_HAS_STRM_POS_OUT (1 << 13)
! #define IOPARM_INQUIRE_HAS_FILE		(1 << 14)
! #define IOPARM_INQUIRE_HAS_ACCESS	(1 << 15)
! #define IOPARM_INQUIRE_HAS_FORM		(1 << 16)
! #define IOPARM_INQUIRE_HAS_BLANK	(1 << 17)
! #define IOPARM_INQUIRE_HAS_POSITION	(1 << 18)
! #define IOPARM_INQUIRE_HAS_ACTION	(1 << 19)
! #define IOPARM_INQUIRE_HAS_DELIM	(1 << 20)
! #define IOPARM_INQUIRE_HAS_PAD		(1 << 21)
! #define IOPARM_INQUIRE_HAS_NAME		(1 << 22)
! #define IOPARM_INQUIRE_HAS_SEQUENTIAL	(1 << 23)
! #define IOPARM_INQUIRE_HAS_DIRECT	(1 << 24)
! #define IOPARM_INQUIRE_HAS_FORMATTED	(1 << 25)
! #define IOPARM_INQUIRE_HAS_UNFORMATTED	(1 << 26)
! #define IOPARM_INQUIRE_HAS_READ		(1 << 27)
! #define IOPARM_INQUIRE_HAS_WRITE	(1 << 28)
! #define IOPARM_INQUIRE_HAS_READWRITE	(1 << 29)
! #define IOPARM_INQUIRE_HAS_CONVERT	(1 << 30)
  
  typedef struct
  {
    st_parameter_common common;
    GFC_INTEGER_4 *exist, *opened, *number, *named;
    GFC_INTEGER_4 *nextrec, *recl_out;
+   GFC_IO_INT *strm_pos_out;
    CHARACTER1 (file);
    CHARACTER2 (access);
    CHARACTER1 (form);
*************** struct format_data;
*** 351,357 ****
  typedef struct st_parameter_dt
  {
    st_parameter_common common;
!   GFC_LARGE_IO_INT rec;
    GFC_INTEGER_4 *size, *iolength;
    gfc_array_char *internal_unit_desc;
    CHARACTER1 (format);
--- 353,359 ----
  typedef struct st_parameter_dt
  {
    st_parameter_common common;
!   GFC_IO_INT rec;
    GFC_INTEGER_4 *size, *iolength;
    gfc_array_char *internal_unit_desc;
    CHARACTER1 (format);
*************** internal_proto(is_internal_unit);
*** 709,714 ****
--- 711,719 ----
  extern int is_array_io (st_parameter_dt *);
  internal_proto(is_array_io);
  
+ extern int is_stream_io (st_parameter_dt *);
+ internal_proto(is_stream_io);
+ 
  extern gfc_unit *find_unit (int);
  internal_proto(find_unit);
  
Index: libgfortran/io/inquire.c
===================================================================
*** libgfortran/io/inquire.c	(revision 116057)
--- libgfortran/io/inquire.c	(working copy)
*************** inquire_via_unit (st_parameter_inquire *
*** 75,80 ****
--- 75,83 ----
  	  case ACCESS_DIRECT:
  	    p = "DIRECT";
  	    break;
+ 	  case ACCESS_STREAM:
+ 	    p = "STREAM";
+ 	    break;
  	  default:
  	    internal_error (&iqp->common, "inquire_via_unit(): Bad access");
  	  }
*************** inquire_via_unit (st_parameter_inquire *
*** 145,150 ****
--- 148,156 ----
    if ((cf & IOPARM_INQUIRE_HAS_RECL_OUT) != 0)
      *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;
  
Index: libgfortran/io/unit.c
===================================================================
*** libgfortran/io/unit.c	(revision 116057)
--- libgfortran/io/unit.c	(working copy)
*************** is_array_io (st_parameter_dt *dtp)
*** 493,498 ****
--- 493,507 ----
  }
  
  
+ /* is_stream_io () -- Determine if I/O is access="stream" mode */
+ 
+ int
+ is_stream_io (st_parameter_dt *dtp)
+ {
+   return dtp->u.p.current_unit->flags.access == ACCESS_STREAM;
+ }
+ 
+ 
  /*************************/
  /* Initialize everything */
  
Index: libgfortran/io/transfer.c
===================================================================
*** libgfortran/io/transfer.c	(revision 116057)
--- libgfortran/io/transfer.c	(working copy)
*************** static const st_option advance_opt[] = {
*** 91,97 ****
  
  typedef enum
  { FORMATTED_SEQUENTIAL, UNFORMATTED_SEQUENTIAL,
!   FORMATTED_DIRECT, UNFORMATTED_DIRECT
  }
  file_mode;
  
--- 91,97 ----
  
  typedef enum
  { FORMATTED_SEQUENTIAL, UNFORMATTED_SEQUENTIAL,
!   FORMATTED_DIRECT, UNFORMATTED_DIRECT, FORMATTED_STREAM, UNFORMATTED_STREAM
  }
  file_mode;
  
*************** current_mode (st_parameter_dt *dtp)
*** 101,116 ****
  {
    file_mode m;
  
    if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT)
      {
        m = dtp->u.p.current_unit->flags.form == FORM_FORMATTED ?
  	FORMATTED_DIRECT : UNFORMATTED_DIRECT;
      }
!   else
      {
        m = dtp->u.p.current_unit->flags.form == FORM_FORMATTED ?
  	FORMATTED_SEQUENTIAL : UNFORMATTED_SEQUENTIAL;
      }
  
    return m;
  }
--- 101,123 ----
  {
    file_mode m;
  
+   m = FORM_UNSPECIFIED;
+ 
    if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT)
      {
        m = dtp->u.p.current_unit->flags.form == FORM_FORMATTED ?
  	FORMATTED_DIRECT : UNFORMATTED_DIRECT;
      }
!   else if (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL)
      {
        m = dtp->u.p.current_unit->flags.form == FORM_FORMATTED ?
  	FORMATTED_SEQUENTIAL : UNFORMATTED_SEQUENTIAL;
      }
+   else if (dtp->u.p.current_unit->flags.access == ACCESS_STREAM)
+     {
+       m = dtp->u.p.current_unit->flags.form == FORM_FORMATTED ?
+ 	FORMATTED_STREAM : UNFORMATTED_STREAM;
+     }
  
    return m;
  }
*************** current_mode (st_parameter_dt *dtp)
*** 128,134 ****
     an I/O error.
  
     Given this, the solution is to read a byte at a time, stopping if
!    we hit the newline.  For small locations, we use a static buffer.
     For larger allocations, we are forced to allocate memory on the
     heap.  Hopefully this won't happen very often.  */
  
--- 135,141 ----
     an I/O error.
  
     Given this, the solution is to read a byte at a time, stopping if
!    we hit the newline.  For small allocations, we use a static buffer.
     For larger allocations, we are forced to allocate memory on the
     heap.  Hopefully this won't happen very often.  */
  
*************** read_block (st_parameter_dt *dtp, int *l
*** 256,311 ****
    char *source;
    int nread;
  
!   if (dtp->u.p.current_unit->bytes_left < *length)
      {
!       /* For preconnected units with default record length, set bytes left
! 	 to unit record length and proceed, otherwise error.  */
!       if (dtp->u.p.current_unit->unit_number == options.stdin_unit
! 	  && dtp->u.p.current_unit->recl == DEFAULT_RECL)
!         dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
!       else
  	{
! 	  if (dtp->u.p.current_unit->flags.pad == PAD_NO)
  	    {
! 	      /* Not enough data left.  */
! 	      generate_error (&dtp->common, ERROR_EOR, NULL);
  	      return NULL;
  	    }
  	}
  
!       if (dtp->u.p.current_unit->bytes_left == 0)
  	{
- 	  dtp->u.p.current_unit->endfile = AT_ENDFILE;
  	  generate_error (&dtp->common, ERROR_END, NULL);
  	  return NULL;
  	}
  
!       *length = dtp->u.p.current_unit->bytes_left;
!     }
  
!   if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED &&
!       dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL)
!     return read_sf (dtp, length, 0);	/* Special case.  */
  
!   dtp->u.p.current_unit->bytes_left -= *length;
! 
!   nread = *length;
!   source = salloc_r (dtp->u.p.current_unit->s, &nread);
! 
!   if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
!     dtp->u.p.size_used += (gfc_offset) nread;
! 
!   if (nread != *length)
!     {				/* Short read, this shouldn't happen.  */
!       if (dtp->u.p.current_unit->flags.pad == PAD_YES)
! 	*length = nread;
!       else
! 	{
! 	  generate_error (&dtp->common, ERROR_EOR, NULL);
! 	  source = NULL;
  	}
-     }
  
    return source;
  }
  
--- 263,348 ----
    char *source;
    int nread;
  
!   if (!is_stream_io (dtp))
      {
!       if (dtp->u.p.current_unit->bytes_left < *length)
  	{
! 	  /* For preconnected units with default record length, set bytes left
! 	   to unit record length and proceed, otherwise error.  */
! 	  if (dtp->u.p.current_unit->unit_number == options.stdin_unit
! 	      && dtp->u.p.current_unit->recl == DEFAULT_RECL)
!           dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
! 	  else
  	    {
! 	      if (dtp->u.p.current_unit->flags.pad == PAD_NO)
! 		{
! 		  /* Not enough data left.  */
! 		  generate_error (&dtp->common, ERROR_EOR, NULL);
! 		  return NULL;
! 		}
! 	    }
! 
! 	  if (dtp->u.p.current_unit->bytes_left == 0)
! 	    {
! 	      dtp->u.p.current_unit->endfile = AT_ENDFILE;
! 	      generate_error (&dtp->common, ERROR_END, NULL);
  	      return NULL;
  	    }
+ 
+ 	  *length = dtp->u.p.current_unit->bytes_left;
  	}
  
!       if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED &&
! 	dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL)
! 	  return read_sf (dtp, length, 0);	/* Special case.  */
! 
!       dtp->u.p.current_unit->bytes_left -= (gfc_offset) *length;
! 
!       nread = *length;
!       source = salloc_r (dtp->u.p.current_unit->s, &nread);
! 
!       if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
! 	dtp->u.p.size_used += (gfc_offset) nread;
! 
!       if (nread != *length)
! 	{				/* Short read, this shouldn't happen.  */
! 	  if (dtp->u.p.current_unit->flags.pad == PAD_YES)
! 	    *length = nread;
! 	  else
! 	    {
! 	      generate_error (&dtp->common, ERROR_EOR, NULL);
! 	      source = NULL;
! 	    }
! 	}
!     }
!   else
!     {
!       if (sseek (dtp->u.p.current_unit->s,
! 		 (dtp->rec - 1)) == FAILURE)
  	{
  	  generate_error (&dtp->common, ERROR_END, NULL);
  	  return NULL;
  	}
  
!       nread = *length;
!       source = salloc_r (dtp->u.p.current_unit->s, &nread);
  
!       if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
! 	dtp->u.p.size_used += (gfc_offset) nread;
  
!       if (nread != *length)
! 	{				/* Short read, this shouldn't happen.  */
! 	  if (dtp->u.p.current_unit->flags.pad == PAD_YES)
! 	    *length = nread;
! 	  else
! 	    {
! 	      generate_error (&dtp->common, ERROR_END, NULL);
! 	      source = NULL;
! 	    }
  	}
  
+       dtp->rec += (GFC_IO_INT) nread;
+     }
    return source;
  }
  
*************** read_block_direct (st_parameter_dt *dtp,
*** 319,362 ****
    void *data;
    size_t nread;
  
!   if (dtp->u.p.current_unit->bytes_left < *nbytes)
      {
!       /* For preconnected units with default record length, set bytes left
! 	 to unit record length and proceed, otherwise error.  */
!       if (dtp->u.p.current_unit->unit_number == options.stdin_unit
! 	  && dtp->u.p.current_unit->recl == DEFAULT_RECL)
!         dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
!       else
  	{
! 	  if (dtp->u.p.current_unit->flags.pad == PAD_NO)
  	    {
! 	      /* Not enough data left.  */
! 	      generate_error (&dtp->common, ERROR_EOR, NULL);
  	      return;
  	    }
  	}
  
!       if (dtp->u.p.current_unit->bytes_left == 0)
  	{
! 	  dtp->u.p.current_unit->endfile = AT_ENDFILE;
! 	  generate_error (&dtp->common, ERROR_END, NULL);
  	  return;
  	}
  
!       *nbytes = dtp->u.p.current_unit->bytes_left;
      }
! 
!   if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED &&
!       dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL)
      {
!       length = (int *) nbytes;
!       data = read_sf (dtp, length, 0);	/* Special case.  */
!       memcpy (buf, data, (size_t) *length);
!       return;
      }
  
-   dtp->u.p.current_unit->bytes_left -= *nbytes;
- 
    nread = *nbytes;
    if (sread (dtp->u.p.current_unit->s, buf, &nread) != 0)
      {
--- 356,412 ----
    void *data;
    size_t nread;
  
!   if (!is_stream_io (dtp))
      {
!       if (dtp->u.p.current_unit->bytes_left < (gfc_offset) *nbytes)
  	{
! 	  /* For preconnected units with default record length, set
! 	     bytes left to unit record length and proceed, otherwise
! 	     error.  */
! 	  if (dtp->u.p.current_unit->unit_number == options.stdin_unit
! 	      && dtp->u.p.current_unit->recl == DEFAULT_RECL)
! 	    dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
! 	  else
  	    {
! 	      if (dtp->u.p.current_unit->flags.pad == PAD_NO)
! 		{
! 		  /* Not enough data left.  */
! 		  generate_error (&dtp->common, ERROR_EOR, NULL);
! 		  return;
! 		}
! 	    }
! 	  
! 	  if (dtp->u.p.current_unit->bytes_left == 0)
! 	    {
! 	      dtp->u.p.current_unit->endfile = AT_ENDFILE;
! 	      generate_error (&dtp->common, ERROR_END, NULL);
  	      return;
  	    }
+ 
+ 	  *nbytes = (size_t) dtp->u.p.current_unit->bytes_left;
  	}
  
!       if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED &&
! 	  dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL)
  	{
! 	  length = (int *) nbytes;
! 	  data = read_sf (dtp, length, 0);	/* Special case.  */
! 	  memcpy (buf, data, (size_t) *length);
  	  return;
  	}
  
!       dtp->u.p.current_unit->bytes_left -= (gfc_offset) *nbytes;
      }
!   else
      {
!       if (sseek (dtp->u.p.current_unit->s,
! 	  (gfc_offset)(dtp->rec - 1)) == FAILURE)
! 	{
! 	  generate_error (&dtp->common, ERROR_END, NULL);
! 	  return;
! 	}
      }
  
    nread = *nbytes;
    if (sread (dtp->u.p.current_unit->s, buf, &nread) != 0)
      {
*************** read_block_direct (st_parameter_dt *dtp,
*** 364,381 ****
        return;
      }
  
!   if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
!     dtp->u.p.size_used += (gfc_offset) nread;
  
!   if (nread != *nbytes)
!     {				/* Short read, e.g. if we hit EOF.  */
!       if (dtp->u.p.current_unit->flags.pad == PAD_YES)
! 	{
! 	  memset (((char *) buf) + nread, ' ', *nbytes - nread);
! 	  *nbytes = nread;
! 	}
!       else
  	generate_error (&dtp->common, ERROR_EOR, NULL);
      }
  }
  
--- 414,433 ----
        return;
      }
  
!   if (!is_stream_io (dtp))
!     {
!       if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
! 	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.  */
!     {
!       if (!is_stream_io (dtp))
  	generate_error (&dtp->common, ERROR_EOR, NULL);
+       else
+ 	generate_error (&dtp->common, ERROR_END, NULL);	  
      }
  }
  
*************** write_block (st_parameter_dt *dtp, int l
*** 390,424 ****
  {
    char *dest;
  
!   if (dtp->u.p.current_unit->bytes_left < length)
      {
!       /* For preconnected units with default record length, set bytes left
! 	 to unit record length and proceed, otherwise error.  */
!       if ((dtp->u.p.current_unit->unit_number == options.stdout_unit
! 	  || dtp->u.p.current_unit->unit_number == options.stderr_unit)
! 	  && dtp->u.p.current_unit->recl == DEFAULT_RECL)
!         dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
!       else
  	{
! 	  generate_error (&dtp->common, ERROR_EOR, NULL);
! 	  return NULL;
  	}
-     }
  
!   dtp->u.p.current_unit->bytes_left -= (gfc_offset) length;
!   dest = salloc_w (dtp->u.p.current_unit->s, &length);
    
!   if (dest == NULL)
!     {
!       generate_error (&dtp->common, ERROR_END, NULL);
!       return NULL;
      }
  
!   if (is_internal_unit (dtp) && dtp->u.p.current_unit->endfile == AT_ENDFILE)
!     generate_error (&dtp->common, ERROR_END, NULL);
  
!   if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
!     dtp->u.p.size_used += (gfc_offset) length;
  
    return dest;
  }
--- 442,500 ----
  {
    char *dest;
  
!   if (!is_stream_io (dtp))
      {
!       if (dtp->u.p.current_unit->bytes_left < (gfc_offset) length)
  	{
! 	  /* For preconnected units with default record length, set bytes left
! 	     to unit record length and proceed, otherwise error.  */
! 	  if ((dtp->u.p.current_unit->unit_number == options.stdout_unit
! 		|| dtp->u.p.current_unit->unit_number == options.stderr_unit)
! 		&& dtp->u.p.current_unit->recl == DEFAULT_RECL)
! 	    dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
! 	  else
! 	    {
! 	      generate_error (&dtp->common, ERROR_EOR, NULL);
! 	      return NULL;
! 	    }
  	}
  
!       dtp->u.p.current_unit->bytes_left -= (gfc_offset) length;
! 
! 
!       dest = salloc_w (dtp->u.p.current_unit->s, &length);
    
!       if (dest == NULL)
! 	{
! 	  generate_error (&dtp->common, ERROR_END, NULL);
! 	  return NULL;
! 	}
! 
!       if (is_internal_unit (dtp) && dtp->u.p.current_unit->endfile == AT_ENDFILE)
! 	generate_error (&dtp->common, ERROR_END, NULL);
! 
!       if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
! 	dtp->u.p.size_used += (gfc_offset) length;
      }
+   else
+     {
+       if (sseek (dtp->u.p.current_unit->s,
+ 	  (dtp->rec - 1)) == FAILURE)
+ 	{
+ 	  generate_error (&dtp->common, ERROR_END, NULL);
+ 	  return NULL;
+ 	}
  
!       dest = salloc_w (dtp->u.p.current_unit->s, &length);
  
!       if (dest == NULL)
! 	{
! 	  generate_error (&dtp->common, ERROR_END, NULL);
! 	  return NULL;
! 	}
! 
!       dtp->rec += (GFC_IO_INT) length;
!     }
  
    return dest;
  }
*************** write_block (st_parameter_dt *dtp, int l
*** 429,462 ****
  static try
  write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes)
  {
!   if (dtp->u.p.current_unit->bytes_left < nbytes)
      {
!       /* For preconnected units with default record length, set bytes left
! 	 to unit record length and proceed, otherwise error.  */
!       if ((dtp->u.p.current_unit->unit_number == options.stdout_unit
! 	  || dtp->u.p.current_unit->unit_number == options.stderr_unit)
! 	  && dtp->u.p.current_unit->recl == DEFAULT_RECL)
!         dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
!       else
  	{
! 	  if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT)
! 	    generate_error (&dtp->common, ERROR_DIRECT_EOR, NULL);
  	  else
! 	    generate_error (&dtp->common, ERROR_EOR, NULL);
  	  return FAILURE;
  	}
      }
  
-   dtp->u.p.current_unit->bytes_left -= (gfc_offset) nbytes;
- 
    if (swrite (dtp->u.p.current_unit->s, buf, &nbytes) != 0)
      {
        generate_error (&dtp->common, ERROR_OS, NULL);
        return FAILURE;
      }
  
!   if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
!     dtp->u.p.size_used += (gfc_offset) nbytes;
  
    return SUCCESS;
  }
--- 505,556 ----
  static try
  write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes)
  {
!   if (!is_stream_io (dtp))
      {
!       if (dtp->u.p.current_unit->bytes_left < (gfc_offset) nbytes)
  	{
! 	  /* For preconnected units with default record length, set
! 	     bytes left to unit record length and proceed, otherwise
! 	     error.  */
! 	  if ((dtp->u.p.current_unit->unit_number == options.stdout_unit
! 	       || dtp->u.p.current_unit->unit_number == options.stderr_unit)
! 	      && dtp->u.p.current_unit->recl == DEFAULT_RECL)
! 	    dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
  	  else
! 	    {
! 	      if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT)
! 		generate_error (&dtp->common, ERROR_DIRECT_EOR, NULL);
! 	      else
! 		generate_error (&dtp->common, ERROR_EOR, NULL);
! 	      return FAILURE;
! 	    }
! 	}
! 
!       dtp->u.p.current_unit->bytes_left -= (gfc_offset) nbytes;
!     }
!   else
!     {
!       if (sseek (dtp->u.p.current_unit->s,
! 		 (gfc_offset)(dtp->rec - 1)) == FAILURE)
! 	{
! 	  generate_error (&dtp->common, ERROR_OS, NULL);
  	  return FAILURE;
  	}
      }
  
    if (swrite (dtp->u.p.current_unit->s, buf, &nbytes) != 0)
      {
        generate_error (&dtp->common, ERROR_OS, NULL);
        return FAILURE;
      }
  
!   if (!is_stream_io (dtp))
!     {
!       if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
! 	dtp->u.p.size_used += (gfc_offset) nbytes;
!     }
!   else
!     dtp->rec += (GFC_IO_INT) nbytes; 
  
    return SUCCESS;
  }
*************** unformatted_read (st_parameter_dt *dtp, 
*** 469,486 ****
  		  void *dest, int kind,
  		  size_t size, size_t nelems)
  {
    /* Currently, character implies size=1.  */
    if (dtp->u.p.current_unit->flags.convert == CONVERT_NATIVE
        || size == 1 || type == BT_CHARACTER)
      {
!       size *= nelems;
!       read_block_direct (dtp, dest, &size);
      }
    else
      {
        char buffer[16];
        char *p;
-       size_t i, sz;
        
        /* Break up complex into its constituent reals.  */
        if (type == BT_COMPLEX)
--- 563,581 ----
  		  void *dest, int kind,
  		  size_t size, size_t nelems)
  {
+   size_t i, sz;
+ 
    /* Currently, character implies size=1.  */
    if (dtp->u.p.current_unit->flags.convert == CONVERT_NATIVE
        || size == 1 || type == BT_CHARACTER)
      {
!       sz = size * nelems;
!       read_block_direct (dtp, dest, &sz);
      }
    else
      {
        char buffer[16];
        char *p;
        
        /* Break up complex into its constituent reals.  */
        if (type == BT_COMPLEX)
*************** formatted_transfer_scalar (st_parameter_
*** 721,727 ****
  	  dtp->u.p.skips = dtp->u.p.pending_spaces = 0;
  	}
  
!       bytes_used = (int)(dtp->u.p.current_unit->recl - dtp->u.p.current_unit->bytes_left);
  
        switch (t)
  	{
--- 816,823 ----
  	  dtp->u.p.skips = dtp->u.p.pending_spaces = 0;
  	}
  
!       bytes_used = (int)(dtp->u.p.current_unit->recl
! 			 - dtp->u.p.current_unit->bytes_left);
  
        switch (t)
  	{
*************** pre_position (st_parameter_dt *dtp)
*** 1405,1410 ****
--- 1501,1514 ----
  
    switch (current_mode (dtp))
      {
+     case FORMATTED_STREAM:
+     case UNFORMATTED_STREAM:
+       /* 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:
        if (dtp->u.p.mode == READING)
  	us_read (dtp);
*************** data_transfer_init (st_parameter_dt *dtp
*** 1555,1561 ****
      generate_error (&dtp->common, ERROR_OPTION_CONFLICT,
  		    "Internal file cannot be accessed by UNFORMATTED data transfer");
  
!   /* Check the record number.  */
  
    if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT
        && (cf & IOPARM_DT_HAS_REC) == 0)
--- 1659,1665 ----
      generate_error (&dtp->common, ERROR_OPTION_CONFLICT,
  		    "Internal file cannot be accessed by UNFORMATTED data transfer");
  
!   /* Check the record or position number.  */
  
    if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT
        && (cf & IOPARM_DT_HAS_REC) == 0)
*************** data_transfer_init (st_parameter_dt *dtp
*** 1628,1634 ****
      return;
  
    /* Sanity checks on the record number.  */
- 
    if ((cf & IOPARM_DT_HAS_REC) != 0)
      {
        if (dtp->rec <= 0)
--- 1732,1737 ----
*************** data_transfer_init (st_parameter_dt *dtp
*** 1723,1729 ****
  
    if (read_flag)
      {
!       if (dtp->u.p.current_unit->read_bad)
  	{
  	  generate_error (&dtp->common, ERROR_BAD_OPTION,
  			  "Cannot READ after a nonadvancing WRITE");
--- 1826,1832 ----
  
    if (read_flag)
      {
!       if (dtp->u.p.current_unit->read_bad && !is_stream_io (dtp))
  	{
  	  generate_error (&dtp->common, ERROR_BAD_OPTION,
  			  "Cannot READ after a nonadvancing WRITE");
*************** next_record_r (st_parameter_dt *dtp)
*** 1813,1818 ****
--- 1916,1926 ----
  
    switch (current_mode (dtp))
      {
+     /* No records in STREAM I/O.  */
+     case FORMATTED_STREAM:
+     case UNFORMATTED_STREAM:
+       return;
+     
      case UNFORMATTED_SEQUENTIAL:
  
        /* Skip over tail */
*************** next_record_w (st_parameter_dt *dtp, int
*** 2003,2008 ****
--- 2111,2121 ----
  
    switch (current_mode (dtp))
      {
+     /* No records in STREAM I/O.  */
+     case FORMATTED_STREAM:
+     case UNFORMATTED_STREAM:
+       return;
+ 
      case FORMATTED_DIRECT:
        if (dtp->u.p.current_unit->bytes_left == 0)
  	break;
*************** next_record_w (st_parameter_dt *dtp, int
*** 2166,2171 ****
--- 2279,2287 ----
  void
  next_record (st_parameter_dt *dtp, int done)
  {
+   if (is_stream_io (dtp))
+     return;
+ 
    gfc_offset fp; /* File position.  */
  
    dtp->u.p.current_unit->read_bad = 0;
*************** next_record (st_parameter_dt *dtp, int d
*** 2177,2183 ****
  
    /* keep position up to date for INQUIRE */
    dtp->u.p.current_unit->flags.position = POSITION_ASIS;
- 
    dtp->u.p.current_unit->current_record = 0;
    if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT)
     {
--- 2293,2298 ----
*************** finalize_transfer (st_parameter_dt *dtp)
*** 2238,2244 ****
  
    if ((cf & IOPARM_DT_LIST_FORMAT) != 0 && dtp->u.p.mode == READING)
      finish_list_read (dtp);
!   else
      {
        dtp->u.p.current_unit->current_record = 0;
        if (dtp->u.p.advance_status == ADVANCE_NO || dtp->u.p.seen_dollar)
--- 2353,2359 ----
  
    if ((cf & IOPARM_DT_LIST_FORMAT) != 0 && dtp->u.p.mode == READING)
      finish_list_read (dtp);
!   else if (!is_stream_io (dtp))
      {
        dtp->u.p.current_unit->current_record = 0;
        if (dtp->u.p.advance_status == ADVANCE_NO || dtp->u.p.seen_dollar)
*************** finalize_transfer (st_parameter_dt *dtp)
*** 2250,2258 ****
  	  dtp->u.p.seen_dollar = 0;
  	  return;
  	}
- 
        next_record (dtp, 1);
      }
  
    sfree (dtp->u.p.current_unit->s);
  }
--- 2365,2377 ----
  	  dtp->u.p.seen_dollar = 0;
  	  return;
  	}
        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);
  }
! { dg-do run }
! PR25828 Stream IO test 1
! Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
PROGRAM stream_io_1
  IMPLICIT NONE
  integer(kind=4) i
  real(kind=8) r
  OPEN(UNIT=11, ACCESS="stream")
  WRITE(11) "first"
  WRITE(11) "second"
  WRITE(11) 1234567
  write(11) 3.14159_8
  read(11, pos=12)i
  if (i.ne.1234567) call abort()
  read(11) r
  if (r-3.14159 .gt. 0.00001) call abort()
  CLOSE(UNIT=11, status="delete")
END PROGRAM stream_io_1
! { dg-do run }
! PR25828 Stream IO test 2
! Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
PROGRAM readUstream
  IMPLICIT NONE
  CHARACTER*3 :: string
  INTEGER :: n
  string = "123"
  n = 13579
  OPEN(UNIT=11, FILE="streamio2", ACCESS="STREAM")
  WRITE(11) "first"
  WRITE(11) "second"
  WRITE(11) 7
  READ(11, POS=3) string
  READ(11, POS=12) n
  if (string.ne."rst") call abort()
  if (n.ne.7) call abort()
  close(unit=11, status="delete")
END PROGRAM readUstream
! { dg-do run }
! PR25828 Stream IO test 3, tests read_x and inquire.
! Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
program streamio_3
  implicit none
  integer         :: i(6),j
  character(10)   :: myaccess
  open(10, access="stream", form="formatted")
  i = (/(j,j=1,6)/)
  write(10,'(3(2x,i4/)/3(3x,i6/))') i
  i = 0
  rewind(10)
  read(10,'(3(2x,i4/)/3(3x,i6/))') i
  if (any(i.ne.(/(j,j=1,6)/))) call abort()
  inquire(unit=10, access=myaccess)
  if (myaccess.ne."STREAM") call abort()
  close(10,status="delete")
end program streamio_3
! { dg-do run }
! PR25828 Stream IO test 4, Tests string read and writes, single byte.
! Verifies buffering is working correctly and position="append"
! Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
program streamtest
  implicit none
  character(1)   :: lf = char(10)
  character(1)   :: tchar
  integer        :: i,j,k
  integer, parameter :: lines = 5231
   
  open(10, file="teststream", access="stream", form="formatted")
  
  do i=1,lines
    do j=0,9
      write(10,"(i5)") j
    end do
    write(10,"(a)") lf
  end do
  
  close(10)
  
  open(10, file="teststream", access="stream",&
  &form="formatted", position="append")
  do i=1,lines
    do j=0,9
      write(10,"(i5)") j
    end do
    write(10,"(a)") lf
  end do
  rewind(10)
  do i=1,lines
    do j=0,9
      read(10,"(i5)") k
      if (k.ne.j) call abort()
    end do
    read(10,"(a)") tchar
    if (tchar.ne.lf) call abort()
  end do

  close(10,status="delete")
end program streamtest
! { dg-do run }
! PR25828 Stream IO test 5, unformatted single byte
! Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
program streamtest5
  implicit none
  character(1)   :: lf = char(10)
  character(1)   :: tchar
  integer        :: i,j,k
   
  open(10, file="teststream", access="stream", form="unformatted")
  
  do i=1,1229
    do j=0,9
      write(10) j
    end do
    write(10) lf
  end do
  
  close(10)
  
  open(10, file="teststream", access="stream", form="unformatted")
  
  do i=1,1229
    do j=0,9
      read(10) k
      if (k.ne.j) call abort()
    end do
    read(10) tchar
    if (tchar.ne.lf) call abort()
  end do
  close(10,status="delete")
end program streamtest5
! { dg-do run }
! PR25828 Stream IO test 6, random writes and reads.
! Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
program streamio_6
  implicit none
  integer, dimension(100) :: a
  character(1) :: c
  integer :: i,j,k,ier
  real    :: x
  data a / 13, 9, 34, 41, 25, 98, 6, 12, 11, 44, 79, 3,&
  &    64, 61, 77, 57, 59, 2, 92, 38, 71, 64, 31, 60, 28, 90, 26,&
  &    97, 47, 26, 48, 96, 95, 82, 100, 90, 45, 71, 71, 67, 72,&
  &    76, 94, 49, 85, 45, 100, 22, 96, 48, 13, 23, 40, 14, 76, 99,&
  &    96, 90, 65,  2, 8, 60, 96, 19, 45, 1, 100, 48, 91, 20, 92,&
  &    72, 81, 59, 24, 37, 43, 21, 54, 68, 31, 19, 79, 63, 41,&
  &    42, 12, 10, 62, 43, 9, 30, 9, 54, 35, 4, 5, 55, 3, 94 /

  open(unit=15,file="teststream",access="stream",form="unformatted")
  do i=1,100
    k = a(i)
    write(unit=15, pos=k) achar(k)
  enddo
  do j=1,100
    read(unit=15, pos=a(j), iostat=ier) c
    if (ier.ne.0) then
      call abort
    else
      if (achar(a(j)) /= c) call abort
    endif
  enddo
  close(unit=15, status="delete")
end program streamio_6
! { dg-do run }
! PR25828 Stream IO test 7, Array writes and reads.
! Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
program streamtest
  implicit none
  character(1)   :: lf = char(10)
  character(1)   :: tchar
  integer        :: i,j,k
  real(kind=4), dimension(100,100) :: anarray
  open(10, file="teststream", access="stream", form="unformatted")
  anarray = 3.14159
  write(10) anarray
  anarray = 0.0
  read(10, pos=1) anarray
  anarray = abs(anarray - 3.14159)
  if (any(anarray.gt.0.00001)) call abort()
  close(10,status="delete")
end program streamtest
! { dg-do run }
! PR25828 Stream IO test 8
! Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
PROGRAM stream_io_8
  IMPLICIT NONE
  integer(kind=8) mypos
  character(10) mystring
  real(kind=8) r
  mypos = 0
  mystring = "not yet"
  r = 12.25
  OPEN(UNIT=11, ACCESS="stream")
  inquire(unit=11, pos=mypos)
  if (mypos.ne.1) call abort()
  WRITE(11) "first"
  inquire(unit=11, pos=mypos)
  if (mypos.ne.6) call abort()
  WRITE(11) "second"
  inquire(unit=11, pos=mypos)
  if (mypos.ne.12) call abort()
  WRITE(11) 1234567
  inquire(unit=11, pos=mypos)
  if (mypos.ne.16) call abort()
  write(11) r
  r = 0.0
  inquire (11, pos=mypos)
  read(11,pos=16)r
  if (r.ne.12.25) call abort()
  inquire(unit=11, pos=mypos)
  inquire(unit=11, access=mystring)
  if (mypos.ne.24) call abort()
  if (mystring.ne."STREAM") call abort()
  CLOSE(UNIT=11, status="delete")
END PROGRAM stream_io_8

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