[patch, libgfortran] Fix for PR 18982

[Thomas Koenig]

Here's another go at fixing PR 18982.

Testcase is also attached.

Ok?

2005-01-17  Thomas Koenig <Thomas.Koenig@online.de>

	PR libfortran/18982
	* io/unix.c (regular_file):  No need to change flags->action
	if an error occurs.  Document this.  
	No need to call stat() for STATUS_OLD, open() will
	fail anyway.
	For ACTION_UNSPECIFIED, try open for read-write, then for
	read-only if open fails with EACCES, then for write-only
	if that fails with EACCES again.
	* io/unix.c (open_external): Document changed behavior of
	regular_file.
	
-------------- next part --------------
Index: unix.c
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/io/unix.c,v
retrieving revision 1.19
diff -c -r1.19 unix.c
*** unix.c	12 Jan 2005 21:27:31 -0000	1.19
--- unix.c	17 Jan 2005 20:44:21 -0000
***************
*** 998,1013 ****
  
  
  /* regular_file()-- Open a regular file.
!  * Change flags->action if it is ACTION_UNSPECIFIED on entry.
   * Returns the descriptor, which is less than zero on error. */
  
  static int
  regular_file (unit_flags *flags)
  {
    char path[PATH_MAX + 1];
-   struct stat statbuf;
    int mode;
    int rwflag;
    int fd;
  
    if (unpack_filename (path, ioparm.file, ioparm.file_len))
--- 998,1014 ----
  
  
  /* regular_file()-- Open a regular file.
!  * Change flags->action if it is ACTION_UNSPECIFIED on entry,
!  * unless an error occurs.
   * Returns the descriptor, which is less than zero on error. */
  
  static int
  regular_file (unit_flags *flags)
  {
    char path[PATH_MAX + 1];
    int mode;
    int rwflag;
+   int crflag;
    int fd;
  
    if (unpack_filename (path, ioparm.file, ioparm.file_len))
***************
*** 1040,1060 ****
    switch (flags->status)
      {
      case STATUS_NEW:
!       rwflag |= O_CREAT | O_EXCL;
        break;
  
!     case STATUS_OLD:		/* file must exist, so check for its existence */
!       if (stat (path, &statbuf) < 0)
! 	return -1;
        break;
  
      case STATUS_UNKNOWN:
      case STATUS_SCRATCH:
!       rwflag |= O_CREAT;
        break;
  
      case STATUS_REPLACE:
!         rwflag |= O_CREAT | O_TRUNC;
        break;
  
      default:
--- 1041,1060 ----
    switch (flags->status)
      {
      case STATUS_NEW:
!       crflag = O_CREAT | O_EXCL;
        break;
  
!     case STATUS_OLD:		/* open will fail if the file does not exist*/
!       crflag = 0;
        break;
  
      case STATUS_UNKNOWN:
      case STATUS_SCRATCH:
!       crflag = O_CREAT;
        break;
  
      case STATUS_REPLACE:
!         crflag = O_CREAT | O_TRUNC;
        break;
  
      default:
***************
*** 1064,1092 ****
    /* rwflag |= O_LARGEFILE; */
  
    mode = S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH;
!   fd = open (path, rwflag, mode);
!   if (flags->action == ACTION_UNSPECIFIED)
      {
!       if (fd < 0)
!         {
!           rwflag = rwflag & !O_RDWR | O_RDONLY;
!           fd = open (path, rwflag, mode);
!           if (fd < 0)
!             {
! 	      rwflag = rwflag & !O_RDONLY | O_WRONLY;
!               fd = open (path, rwflag, mode);
!               if (fd < 0)
!                 flags->action = ACTION_READWRITE; /* Could not open at all.  */
!               else
!                 flags->action = ACTION_WRITE;
!             }
!           else
!             flags->action = ACTION_READ;
!         }
!       else
!         flags->action = ACTION_READWRITE;
      }
!   return fd;
  }
  
  
--- 1064,1102 ----
    /* rwflag |= O_LARGEFILE; */
  
    mode = S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH;
!   fd = open (path, rwflag | crflag, mode);
!   if (flags->action != ACTION_UNSPECIFIED)
!       return fd;
! 
!   if (fd >= 0)
      {
!       flags->action = ACTION_READWRITE;
!       return fd;
!     }
!   if (errno != EACCES)
!      return fd;
! 
!   /* retry for read-only access */
!   rwflag = O_RDONLY;
!   fd = open (path, rwflag | crflag, mode);
!   if (fd >=0)
!     {
!       flags->action = ACTION_READ;
!       return fd;               /* success */
!     }
!   
!   if (errno != EACCES)
!     return fd;                 /* failure */
! 
!   /* retry for write-only access */
!   rwflag = O_WRONLY;
!   fd = open (path, rwflag | crflag, mode);
!   if (fd >=0)
!     {
!       flags->action = ACTION_WRITE;
!       return fd;               /* success */
      }
!   return fd;                   /* failure */
  }
  
  
***************
*** 1109,1115 ****
      }
    else
      {
!       /* regular_file resets flags->action if it is ACTION_UNSPECIFIED.  */
        fd = regular_file (flags);
      }
  
--- 1119,1126 ----
      }
    else
      {
!       /* regular_file resets flags->action if it is ACTION_UNSPECIFIED and
!        * if it succeeds */
        fd = regular_file (flags);
      }
  
-------------- next part --------------
! { dg do-run }
! PR 18982:  verifies that opening an existing file with
!            status="new" is an error
program main
  nout = 10
  open(nout, file="foo.dat", status="replace")     ! make sure foo.dat exists
  close(nout)
  open(nout, file="foo.dat", status="new",err=100)
  call abort                 ! This should never happen
100 continue
end program main