New I/O specifiers CARRIAGECONTROL, READONLY, SHARE with -fdec.

	gcc/fortran/
	* gfortran.texi: Document.
	* frontend-passes.c (gfc_code_walker): Add SHARE and CARRIAGECONTROL.
	* io.c (gfc_free_open, gfc_resolve_open, gfc_match_open): Ditto.
	* gfortran.h (gfc_open): Add SHARE, CARRIAGECONTROL, and READONLY.
	* io.c (io_tag, match_open_element): Ditto.
	* ioparm.def: Ditto.
	* trans-io.c (gfc_trans_open): Ditto.
	* io.c (match_dec_etag, match_dec_ftag): New functions.

	libgfortran/io/
	* libgfortran.h (IOPARM_OPEN_HAS_READONLY, IOPARM_OPEN_HAS_SHARE,
	IOPARM_OPEN_HAS_CC): New for READONLY, SHARE, and CARRIAGECONTROL.
	* close.c (st_close): Support READONLY.
	* io.h (st_parameter_open, unit_flags): Support SHARE, CARRIAGECONTROL,
	and READONLY.
	* open.c (st_open): Ditto.
	* transfer.c (data_transfer_init): Ditto.
	* io.h (st_parameter_dt): New member 'cc' for CARRIAGECONTROL.
	* write.c (write_check_cc, write_cc): New functions for CARRIAGECONTROL.
	* transfer.c (next_record_cc): Ditto.
	* file_pos.c (st_endfile): Support SHARE and CARRIAGECONTROL.
	* io.h (st_parameter_inquire): Ditto.
	* open.c (edit_modes, new_unit): Ditto.
	* inquire.c (inquire_via_unit, inquire_via_filename): Ditto.
	* io.h (unit_share, unit_cc, cc_fortran, IOPARM_INQUIRE_HAS_SHARE,
	IOPARM_INQUIRE_HAS_CC): New for SHARE and CARRIAGECONTROL.
	* open.c (share_opt, cc_opt): Ditto.
	* read.c (read_x): Support CARRIAGECONTROL.
	* transfer.c (read_sf, next_record_r, next_record_w): Ditto.
	* write.c (list_formatted_write_scalar, write_a): Ditto.
	* unix.h (close_share): New prototype.
	* unix.c (open_share, close_share): New functions to handle SHARE.
	* unix.c (open_external): Handle READONLY. Call open_share.
	* close.c (st_close): Call close_share.

	gcc/testsuite/
	* dec_io_1.f90: New test.
        * dec_io_2.f90: New test.
        * dec_io_3.f90: New test.
        * dec_io_4.f90: New test.
        * dec_io_5.f90: New test.
        * dec_io_6.f90: New test.

From-SVN: r241550

1 files changed, 49 insertions, 10 deletions

diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index e3f75b6..b8eb5ed 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -316,7 +316,8 @@ read_sf (st_parameter_dt *dtp, int * length)
       q = fbuf_getc (dtp->u.p.current_unit);
       if (q == EOF)
 	break;
-      else if (q == '\n' || q == '\r')
+      else if (dtp->u.p.current_unit->flags.cc != CC_NONE
+	       && (q == '\n' || q == '\r'))
 	{
 	  /* Unexpected end of line. Set the position.  */
 	  dtp->u.p.sf_seen_eor = 1;
@@ -2598,6 +2599,8 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
   dtp->u.p.ionml = ionml;
   dtp->u.p.mode = read_flag ? READING : WRITING;
 
+  dtp->u.p.cc.len = 0;
+
   if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK)
     return;
 
@@ -2636,6 +2639,9 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
       u_flags.async = ASYNC_UNSPECIFIED;
       u_flags.round = ROUND_UNSPECIFIED;
       u_flags.sign = SIGN_UNSPECIFIED;
+      u_flags.share = SHARE_UNSPECIFIED;
+      u_flags.cc = CC_UNSPECIFIED;
+      u_flags.readonly = 0;
 
       u_flags.status = STATUS_UNKNOWN;
 
@@ -3349,7 +3355,7 @@ next_record_r (st_parameter_dt *dtp, int done)
 	    }
 	  break;
 	}
-      else
+      else if (dtp->u.p.current_unit->flags.cc != CC_NONE)
 	{
 	  do
 	    {
@@ -3531,6 +3537,30 @@ sset (stream * s, int c, ssize_t nbyte)
 }
 
 
+/* Finish up a record according to the legacy carriagecontrol type, based
+   on the first character in the record.  */
+
+static void
+next_record_cc (st_parameter_dt *dtp)
+{
+  /* Only valid with CARRIAGECONTROL=FORTRAN.  */
+  if (dtp->u.p.current_unit->flags.cc != CC_FORTRAN)
+    return;
+
+  fbuf_seek (dtp->u.p.current_unit, 0, SEEK_END);
+  if (dtp->u.p.cc.len > 0)
+    {
+      char * p = fbuf_alloc (dtp->u.p.current_unit, dtp->u.p.cc.len);
+      if (!p)
+	generate_error (&dtp->common, LIBERROR_OS, NULL);
+
+      /* Output CR for the first character with default CC setting.  */
+      *(p++) = dtp->u.p.cc.u.end;
+      if (dtp->u.p.cc.len > 1)
+	*p = dtp->u.p.cc.u.end;
+    }
+}
+
 /* Position to the next record in write mode.  */
 
 static void
@@ -3677,21 +3707,30 @@ next_record_w (st_parameter_dt *dtp, int done)
 		}
 	    }
 	}
+      /* Handle legacy CARRIAGECONTROL line endings.  */
+      else if (dtp->u.p.current_unit->flags.cc == CC_FORTRAN)
+	next_record_cc (dtp);
       else
 	{
+	  /* Skip newlines for CC=CC_NONE.  */
+	  const int len = (dtp->u.p.current_unit->flags.cc == CC_NONE)
+	    ? 0
 #ifdef HAVE_CRLF
-	  const int len = 2;
+	    : 2;
 #else
-	  const int len = 1;
+	    : 1;
 #endif
-          fbuf_seek (dtp->u.p.current_unit, 0, SEEK_END);
-          char * p = fbuf_alloc (dtp->u.p.current_unit, len);
-          if (!p)
-            goto io_error;
+	  fbuf_seek (dtp->u.p.current_unit, 0, SEEK_END);
+	  if (dtp->u.p.current_unit->flags.cc != CC_NONE)
+	    {
+	      char * p = fbuf_alloc (dtp->u.p.current_unit, len);
+	      if (!p)
+		goto io_error;
 #ifdef HAVE_CRLF
-          *(p++) = '\r';
+	      *(p++) = '\r';
 #endif
-          *p = '\n';
+	      *p = '\n';
+	    }
 	  if (is_stream_io (dtp))
 	    {
 	      dtp->u.p.current_unit->strm_pos += len;