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.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@241550 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 140 insertions, 1 deletions

diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index d4b1bc895ed..c8bba3c0bb8 100644
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -228,6 +228,138 @@ write_utf8_char4 (st_parameter_dt *dtp, gfc_char4_t *source,
 }
 
 
+/* Check the first character in source if we are using CC_FORTRAN
+   and set the cc.type appropriately.   The cc.type is used later by write_cc
+   to determine the output start-of-record, and next_record_cc to determine the
+   output end-of-record.
+   This function is called before the output buffer is allocated, so alloc_len
+   is set to the appropriate size to allocate.  */
+
+static void
+write_check_cc (st_parameter_dt *dtp, const char **source, int *alloc_len)
+{
+  /* Only valid for CARRIAGECONTROL=FORTRAN.  */
+  if (dtp->u.p.current_unit->flags.cc != CC_FORTRAN
+      || alloc_len == NULL || source == NULL)
+    return;
+
+  /* Peek at the first character.  */
+  int c = (*alloc_len > 0) ? (*source)[0] : EOF;
+  if (c != EOF)
+    {
+      /* The start-of-record character which will be printed.  */
+      dtp->u.p.cc.u.start = '\n';
+      /* The number of characters to print at the start-of-record.
+	 len  > 1 means copy the SOR character multiple times.
+	 len == 0 means no SOR will be output.  */
+      dtp->u.p.cc.len = 1;
+
+      switch (c)
+	{
+	case '+':
+	  dtp->u.p.cc.type = CCF_OVERPRINT;
+	  dtp->u.p.cc.len = 0;
+	  break;
+	case '-':
+	  dtp->u.p.cc.type = CCF_ONE_LF;
+	  dtp->u.p.cc.len = 1;
+	  break;
+	case '0':
+	  dtp->u.p.cc.type = CCF_TWO_LF;
+	  dtp->u.p.cc.len = 2;
+	  break;
+	case '1':
+	  dtp->u.p.cc.type = CCF_PAGE_FEED;
+	  dtp->u.p.cc.len = 1;
+	  dtp->u.p.cc.u.start = '\f';
+	  break;
+	case '$':
+	  dtp->u.p.cc.type = CCF_PROMPT;
+	  dtp->u.p.cc.len = 1;
+	  break;
+	case '\0':
+	  dtp->u.p.cc.type = CCF_OVERPRINT_NOA;
+	  dtp->u.p.cc.len = 0;
+	  break;
+	default:
+	  /* In the default case we copy ONE_LF.  */
+	  dtp->u.p.cc.type = CCF_DEFAULT;
+	  dtp->u.p.cc.len = 1;
+	  break;
+      }
+
+      /* We add n-1 to alloc_len so our write buffer is the right size.
+	 We are replacing the first character, and possibly prepending some
+	 additional characters.  Note for n==0, we actually subtract one from
+	 alloc_len, which is correct, since that character is skipped.  */
+      if (*alloc_len > 0)
+	{
+	  *source += 1;
+	  *alloc_len += dtp->u.p.cc.len - 1;
+	}
+      /* If we have no input, there is no first character to replace.  Make
+	 sure we still allocate enough space for the start-of-record string.  */
+      else
+	*alloc_len = dtp->u.p.cc.len;
+    }
+}
+
+
+/* Write the start-of-record character(s) for CC_FORTRAN.
+   Also adjusts the 'cc' struct to contain the end-of-record character
+   for next_record_cc.
+   The source_len is set to the remaining length to copy from the source,
+   after the start-of-record string was inserted.  */
+
+static char *
+write_cc (st_parameter_dt *dtp, char *p, int *source_len)
+{
+  /* Only valid for CARRIAGECONTROL=FORTRAN.  */
+  if (dtp->u.p.current_unit->flags.cc != CC_FORTRAN || source_len == NULL)
+    return p;
+
+  /* Write the start-of-record string to the output buffer.  Note that len is
+     never more than 2.  */
+  if (dtp->u.p.cc.len > 0)
+    {
+      *(p++) = dtp->u.p.cc.u.start;
+      if (dtp->u.p.cc.len > 1)
+	  *(p++) = dtp->u.p.cc.u.start;
+
+      /* source_len comes from write_check_cc where it is set to the full
+	 allocated length of the output buffer. Therefore we subtract off the
+	 length of the SOR string to obtain the remaining source length.  */
+      *source_len -= dtp->u.p.cc.len;
+    }
+
+  /* Common case.  */
+  dtp->u.p.cc.len = 1;
+  dtp->u.p.cc.u.end = '\r';
+
+  /* Update end-of-record character for next_record_w.  */
+  switch (dtp->u.p.cc.type)
+    {
+    case CCF_PROMPT:
+    case CCF_OVERPRINT_NOA:
+      /* No end-of-record.  */
+      dtp->u.p.cc.len = 0;
+      dtp->u.p.cc.u.end = '\0';
+      break;
+    case CCF_OVERPRINT:
+    case CCF_ONE_LF:
+    case CCF_TWO_LF:
+    case CCF_PAGE_FEED:
+    case CCF_DEFAULT:
+    default:
+      /* Carriage return.  */
+      dtp->u.p.cc.len = 1;
+      dtp->u.p.cc.u.end = '\r';
+      break;
+    }
+
+  return p;
+}
+
 void
 write_a (st_parameter_dt *dtp, const fnode *f, const char *source, int len)
 {
@@ -296,10 +428,16 @@ write_a (st_parameter_dt *dtp, const fnode *f, const char *source, int len)
   else
     {
 #endif
+      if (dtp->u.p.current_unit->flags.cc == CC_FORTRAN)
+	write_check_cc (dtp, &source, &wlen);
+
       p = write_block (dtp, wlen);
       if (p == NULL)
 	return;
 
+      if (dtp->u.p.current_unit->flags.cc == CC_FORTRAN)
+	p = write_cc (dtp, p, &wlen);
+
       if (unlikely (is_char4_unit (dtp)))
 	{
 	  gfc_char4_t *p4 = (gfc_char4_t *) p;
@@ -1726,7 +1864,8 @@ list_formatted_write_scalar (st_parameter_dt *dtp, bt type, void *p, int kind,
   if (dtp->u.p.first_item)
     {
       dtp->u.p.first_item = 0;
-      write_char (dtp, ' ');
+      if (dtp->u.p.current_unit->flags.cc != CC_FORTRAN)
+	write_char (dtp, ' ');
     }
   else
     {