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, 88 insertions, 1 deletions

diff --git a/libgfortran/io/unix.c b/libgfortran/io/unix.c
index 1e84c42..5301b84 100644
--- a/libgfortran/io/unix.c
+++ b/libgfortran/io/unix.c
@@ -1425,6 +1425,56 @@ regular_file2 (const char *path, st_parameter_open *opp, unit_flags *flags)
 }
 
 
+/* Lock the file, if necessary, based on SHARE flags.  */
+
+#if defined(HAVE_FCNTL) && defined(F_SETLK) && defined(F_UNLCK)
+static int
+open_share (st_parameter_open *opp, int fd, unit_flags *flags)
+{
+  int r = 0;
+  struct flock f;
+  if (fd == STDOUT_FILENO || fd == STDERR_FILENO || fd == STDIN_FILENO)
+    return 0;
+
+  f.l_start = 0;
+  f.l_len = 0;
+  f.l_whence = SEEK_SET;
+
+  switch (flags->share)
+  {
+    case SHARE_DENYNONE:
+      f.l_type = F_RDLCK;
+      r = fcntl (fd, F_SETLK, &f);
+      break;
+    case SHARE_DENYRW:
+      /* Must be writable to hold write lock.  */
+      if (flags->action == ACTION_READ)
+	{
+	  generate_error (&opp->common, LIBERROR_BAD_ACTION,
+	      "Cannot set write lock on file opened for READ");
+	  return -1;
+	}
+      f.l_type = F_WRLCK;
+      r = fcntl (fd, F_SETLK, &f);
+      break;
+    case SHARE_UNSPECIFIED:
+    default:
+      break;
+  }
+
+  return r;
+}
+#else
+static int
+open_share (st_parameter_open *opp __attribute__ ((unused)),
+    int fd __attribute__ ((unused)),
+    unit_flags *flags __attribute__ ((unused)))
+{
+  return 0;
+}
+#endif /* defined(HAVE_FCNTL) ... */
+
+
 /* Wrapper around regular_file2, to make sure we free the path after
    we're done.  */
 
@@ -1450,7 +1500,7 @@ open_external (st_parameter_open *opp, unit_flags *flags)
     {
       fd = tempfile (opp);
       if (flags->action == ACTION_UNSPECIFIED)
-	flags->action = ACTION_READWRITE;
+	flags->action = flags->readonly ? ACTION_READ : ACTION_READWRITE;
 
 #if HAVE_UNLINK_OPEN_FILE
       /* We can unlink scratch files now and it will go away when closed. */
@@ -1472,6 +1522,9 @@ open_external (st_parameter_open *opp, unit_flags *flags)
     return NULL;
   fd = fix_fd (fd);
 
+  if (open_share (opp, fd, flags) < 0)
+    return NULL;
+
   return fd_to_stream (fd, flags->form == FORM_UNFORMATTED);
 }
 
@@ -1752,6 +1805,40 @@ flush_all_units (void)
 }
 
 
+/* Unlock the unit if necessary, based on SHARE flags.  */
+
+int
+close_share (gfc_unit *u __attribute__ ((unused)))
+{
+  int r = 0;
+#if defined(HAVE_FCNTL) && defined(F_SETLK) && defined(F_UNLCK)
+  unix_stream *s = (unix_stream *) u->s;
+  int fd = s->fd;
+  struct flock f;
+
+  switch (u->flags.share)
+  {
+    case SHARE_DENYRW:
+    case SHARE_DENYNONE:
+      if (fd != STDOUT_FILENO && fd != STDERR_FILENO && fd != STDIN_FILENO)
+	{
+	  f.l_start = 0;
+	  f.l_len = 0;
+	  f.l_whence = SEEK_SET;
+	  f.l_type = F_UNLCK;
+	  r = fcntl (fd, F_SETLK, &f);
+	}
+      break;
+    case SHARE_UNSPECIFIED:
+    default:
+      break;
+  }
+
+#endif
+  return r;
+}
+
+
 /* file_exists()-- Returns nonzero if the current filename exists on
  * the system */