This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
Re: libgfortran patch for fortran PR 18653
- From: Steve Ellcey <sje at cup dot hp dot com>
- To: fortran at gcc dot gnu dot org, gcc-patches at gcc dot gnu dot org
- Date: Fri, 3 Dec 2004 16:20:45 -0800 (PST)
- Subject: Re: libgfortran patch for fortran PR 18653
Here is a new version of my patch to fix fortran PR 18653. It has been
tested on ia64-hp-hpux11.23 with no regressions. It lets the lower
level routines set flags->action based on what kind of open works.
Ok for checkin?
Steve Ellcey
sje@cup.hp.com
2004-12-03 Steve Ellcey <sje@cup.hp.com>
* io/io.h (open_external): Change prototype.
* io/unix.c (regular_file): Change prototype and set flags->action if
needed.
(open_external): Ditto.
* io/open.c (new_unit): Let open_external set flags->action.
*** gcc.orig/libgfortran/io/io.h Wed Dec 1 10:22:48 2004
--- gcc/libgfortran/io/io.h Fri Dec 3 16:00:42 2004
*************** int compare_files (stream *, stream *);
*** 400,406 ****
stream *init_error_stream (void);
#define open_external prefix(open_external)
! stream *open_external (unit_action, unit_status);
#define open_internal prefix(open_internal)
stream *open_internal (char *, int);
--- 400,406 ----
stream *init_error_stream (void);
#define open_external prefix(open_external)
! stream *open_external (unit_flags *);
#define open_internal prefix(open_internal)
stream *open_internal (char *, int);
*** gcc.orig/libgfortran/io/unix.c Wed Dec 1 10:22:58 2004
--- gcc/libgfortran/io/unix.c Fri Dec 3 16:09:18 2004
*************** tempfile (void)
*** 988,1001 ****
}
! /* regular_file()-- Open a regular file. Returns the descriptor, which is less than zero on error. */
static int
! regular_file (unit_action action, unit_status status)
{
char path[PATH_MAX + 1];
struct stat statbuf;
int mode;
if (unpack_filename (path, ioparm.file, ioparm.file_len))
{
--- 988,1005 ----
}
! /* 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))
{
*************** regular_file (unit_action action, unit_s
*** 1003,1032 ****
return -1;
}
! mode = 0;
! switch (action)
{
case ACTION_READ:
! mode = O_RDONLY;
break;
case ACTION_WRITE:
! mode = O_WRONLY;
break;
case ACTION_READWRITE:
! mode = O_RDWR;
break;
default:
internal_error ("regular_file(): Bad action");
}
! switch (status)
{
case STATUS_NEW:
! mode |= O_CREAT | O_EXCL;
break;
case STATUS_OLD: /* file must exist, so check for its existence */
--- 1007,1037 ----
return -1;
}
! rwflag = 0;
! switch (flags->action)
{
case ACTION_READ:
! rwflag = O_RDONLY;
break;
case ACTION_WRITE:
! rwflag = O_WRONLY;
break;
case ACTION_READWRITE:
! case ACTION_UNSPECIFIED:
! rwflag = O_RDWR;
break;
default:
internal_error ("regular_file(): Bad action");
}
! switch (flags->status)
{
case STATUS_NEW:
! rwflag |= O_CREAT | O_EXCL;
break;
case STATUS_OLD: /* file must exist, so check for its existence */
*************** regular_file (unit_action action, unit_s
*** 1036,1075 ****
case STATUS_UNKNOWN:
case STATUS_SCRATCH:
! mode |= O_CREAT;
break;
case STATUS_REPLACE:
! mode |= O_CREAT | O_TRUNC;
break;
default:
internal_error ("regular_file(): Bad status");
}
! // mode |= O_LARGEFILE;
! return open (path, mode,
! S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH);
}
/* open_external()-- Open an external file, unix specific version.
* Returns NULL on operating system error. */
stream *
! open_external (unit_action action, unit_status status)
{
int fd, prot;
! fd =
! (status == STATUS_SCRATCH) ? tempfile () : regular_file (action, status);
if (fd < 0)
return NULL;
fd = fix_fd (fd);
! switch (action)
{
case ACTION_READ:
prot = PROT_READ;
--- 1041,1114 ----
case STATUS_UNKNOWN:
case STATUS_SCRATCH:
! rwflag |= O_CREAT;
break;
case STATUS_REPLACE:
! rwflag |= O_CREAT | O_TRUNC;
break;
default:
internal_error ("regular_file(): Bad status");
}
! // 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;
}
/* open_external()-- Open an external file, unix specific version.
+ * Change flags->action if it is ACTION_UNSPECIFIED on entry.
* Returns NULL on operating system error. */
stream *
! open_external (unit_flags *flags)
{
int fd, prot;
! if (flags->status == STATUS_SCRATCH)
! {
! fd = tempfile ();
! if (flags->action == ACTION_UNSPECIFIED)
! flags->action = ACTION_READWRITE;
! /* We can unlink scratch files now and it will go away when closed. */
! unlink (ioparm.file);
! }
! else
! {
! /* regular_file resets flags->action if it is ACTION_UNSPECIFIED. */
! fd = regular_file (flags);
! }
if (fd < 0)
return NULL;
fd = fix_fd (fd);
! switch (flags->action)
{
case ACTION_READ:
prot = PROT_READ;
*************** open_external (unit_action action, unit_
*** 1086,1097 ****
default:
internal_error ("open_external(): Bad action");
}
-
- /* If this is a scratch file, we can unlink it now and the file will
- * go away when it is closed. */
-
- if (status == STATUS_SCRATCH)
- unlink (ioparm.file);
return fd_to_stream (fd, prot);
}
--- 1125,1130 ----
*** gcc.orig/libgfortran/io/open.c Wed Dec 1 10:22:54 2004
--- gcc/libgfortran/io/open.c Fri Dec 3 16:00:47 2004
*************** new_unit (unit_flags * flags)
*** 254,267 ****
stream *s;
char tmpname[5 /* fort. */ + 10 /* digits of unit number */ + 1 /* 0 */];
! /* Change unspecifieds to defaults. */
if (flags->access == ACCESS_UNSPECIFIED)
flags->access = ACCESS_SEQUENTIAL;
- if (flags->action == ACTION_UNSPECIFIED)
- flags->action = ACTION_READWRITE; /* Processor dependent. */
-
if (flags->form == FORM_UNSPECIFIED)
flags->form = (flags->access == ACCESS_SEQUENTIAL)
? FORM_FORMATTED : FORM_UNFORMATTED;
--- 254,266 ----
stream *s;
char tmpname[5 /* fort. */ + 10 /* digits of unit number */ + 1 /* 0 */];
! /* Change unspecifieds to defaults. Leave (flags->action ==
! ACTION_UNSPECIFIED) alone so open_external() can set it based on
! what type of open actually works. */
if (flags->access == ACCESS_UNSPECIFIED)
flags->access = ACCESS_SEQUENTIAL;
if (flags->form == FORM_UNSPECIFIED)
flags->form = (flags->access == ACCESS_SEQUENTIAL)
? FORM_FORMATTED : FORM_UNFORMATTED;
*************** new_unit (unit_flags * flags)
*** 372,378 ****
/* Open file. */
! s = open_external (flags->action, flags->status);
if (s == NULL)
{
generate_error (ERROR_OS, NULL);
--- 371,377 ----
/* Open file. */
! s = open_external (flags);
if (s == NULL)
{
generate_error (ERROR_OS, NULL);