-/* Copyright (C) 2002, 2003, 2004, 2005, 2007, 2008
- Free Software Foundation, Inc.
+/* Copyright (C) 2002-2018 Free Software Foundation, Inc.
Contributed by Andy Vaught
F2003 I/O support contributed by Jerry DeLisle
-This file is part of the GNU Fortran 95 runtime library (libgfortran).
+This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
+the Free Software Foundation; either version 3, or (at your option)
any later version.
-In addition to the permissions in the GNU General Public License, the
-Free Software Foundation gives you unlimited permission to link the
-compiled version of this file into combinations with other programs,
-and to distribute those combinations without any restriction coming
-from the use of this file. (The General Public License restrictions
-do apply in other respects; for example, they cover modification of
-the file, and distribution when not linked into a combine
-executable.)
-
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
-You should have received a copy of the GNU General Public License
-along with Libgfortran; see the file COPYING. If not, write to
-the Free Software Foundation, 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA. */
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
#include "io.h"
+#include "fbuf.h"
+#include "unix.h"
+
+#ifdef HAVE_UNISTD_H
#include <unistd.h>
+#endif
+
#include <string.h>
#include <errno.h>
{ NULL, 0}
};
+static const st_option share_opt[] =
+{
+ { "denyrw", SHARE_DENYRW },
+ { "denynone", SHARE_DENYNONE },
+ { NULL, 0}
+};
+
+static const st_option cc_opt[] =
+{
+ { "list", CC_LIST },
+ { "fortran", CC_FORTRAN },
+ { "none", CC_NONE },
+ { NULL, 0}
+};
+
static const st_option blank_opt[] =
{
{ "null", BLANK_NULL},
AT_ENDFILE. */
static void
-test_endfile (gfc_unit * u)
+test_endfile (gfc_unit *u)
{
- if (u->endfile == NO_ENDFILE && file_length (u->s) == stell (u->s))
- u->endfile = AT_ENDFILE;
+ if (u->endfile == NO_ENDFILE)
+ {
+ gfc_offset sz = ssize (u->s);
+ if (sz == 0 || sz == stell (u->s))
+ u->endfile = AT_ENDFILE;
+ }
}
changed. */
static void
-edit_modes (st_parameter_open *opp, gfc_unit * u, unit_flags * flags)
+edit_modes (st_parameter_open *opp, gfc_unit *u, unit_flags *flags)
{
/* Complain about attempts to change the unchangeable. */
generate_error (&opp->common, LIBERROR_BAD_OPTION,
"Cannot change ACTION parameter in OPEN statement");
+ if (flags->share != SHARE_UNSPECIFIED && u->flags.share != flags->share)
+ generate_error (&opp->common, LIBERROR_BAD_OPTION,
+ "Cannot change SHARE parameter in OPEN statement");
+
+ if (flags->cc != CC_UNSPECIFIED && u->flags.cc != flags->cc)
+ generate_error (&opp->common, LIBERROR_BAD_OPTION,
+ "Cannot change CARRIAGECONTROL parameter in OPEN statement");
+
/* Status must be OLD if present. */
if (flags->status != STATUS_UNSPECIFIED && flags->status != STATUS_OLD &&
u->flags.round = flags->round;
if (flags->sign != SIGN_UNSPECIFIED)
u->flags.sign = flags->sign;
- }
-
- /* Reposition the file if necessary. */
-
- switch (flags->position)
- {
- case POSITION_UNSPECIFIED:
- case POSITION_ASIS:
- break;
-
- case POSITION_REWIND:
- if (sseek (u->s, 0, SEEK_SET) != 0)
- goto seek_error;
- u->current_record = 0;
- u->last_record = 0;
-
- test_endfile (u);
- break;
-
- case POSITION_APPEND:
- if (sseek (u->s, 0, SEEK_END) < 0)
- goto seek_error;
-
- if (flags->access != ACCESS_STREAM)
- u->current_record = 0;
-
- u->endfile = AT_ENDFILE; /* We are at the end. */
- break;
-
- seek_error:
- generate_error (&opp->common, LIBERROR_OS, NULL);
- break;
+ /* Reposition the file if necessary. */
+
+ switch (flags->position)
+ {
+ case POSITION_UNSPECIFIED:
+ case POSITION_ASIS:
+ break;
+
+ case POSITION_REWIND:
+ if (sseek (u->s, 0, SEEK_SET) != 0)
+ goto seek_error;
+
+ u->current_record = 0;
+ u->last_record = 0;
+
+ test_endfile (u);
+ break;
+
+ case POSITION_APPEND:
+ if (sseek (u->s, 0, SEEK_END) < 0)
+ goto seek_error;
+
+ if (flags->access != ACCESS_STREAM)
+ u->current_record = 0;
+
+ u->endfile = AT_ENDFILE; /* We are at the end. */
+ break;
+
+ seek_error:
+ generate_error (&opp->common, LIBERROR_OS, NULL);
+ break;
+ }
}
unlock_unit (u);
/* Open an unused unit. */
gfc_unit *
-new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags)
+new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags *flags)
{
gfc_unit *u2;
stream *s;
if (flags->status == STATUS_UNSPECIFIED)
flags->status = STATUS_UNKNOWN;
+ if (flags->cc == CC_UNSPECIFIED)
+ flags->cc = flags->form == FORM_UNFORMATTED ? CC_NONE : CC_LIST;
+ else if (flags->form == FORM_UNFORMATTED && flags->cc != CC_NONE)
+ {
+ generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
+ "CARRIAGECONTROL parameter conflicts with UNFORMATTED form in "
+ "OPEN statement");
+ goto fail;
+ }
+
/* Checks. */
- if (flags->delim == DELIM_UNSPECIFIED)
- flags->delim = DELIM_NONE;
- else
+ if (flags->delim != DELIM_UNSPECIFIED
+ && flags->form == FORM_UNFORMATTED)
{
- if (flags->form == FORM_UNFORMATTED)
- {
- generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
- "DELIM parameter conflicts with UNFORMATTED form in "
- "OPEN statement");
- goto fail;
- }
+ generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
+ "DELIM parameter conflicts with UNFORMATTED form in "
+ "OPEN statement");
+ goto fail;
}
if (flags->blank == BLANK_UNSPECIFIED)
break;
opp->file = tmpname;
-#ifdef HAVE_SNPRINTF
opp->file_len = snprintf(opp->file, sizeof (tmpname), "fort.%d",
(int) opp->common.unit);
-#else
- opp->file_len = sprintf(opp->file, "fort.%d", (int) opp->common.unit);
-#endif
break;
default:
s = open_external (opp, flags);
if (s == NULL)
{
- char *path, *msg;
- path = (char *) gfc_alloca (opp->file_len + 1);
- msg = (char *) gfc_alloca (opp->file_len + 51);
- unpack_filename (path, opp->file, opp->file_len);
-
- switch (errno)
- {
- case ENOENT:
- sprintf (msg, "File '%s' does not exist", path);
- break;
-
- case EEXIST:
- sprintf (msg, "File '%s' already exists", path);
- break;
-
- case EACCES:
- sprintf (msg, "Permission denied trying to open file '%s'", path);
- break;
-
- case EISDIR:
- sprintf (msg, "'%s' is a directory", path);
- break;
-
- default:
- msg = NULL;
- }
-
+ char errbuf[256];
+ char *path = fc_strdup (opp->file, opp->file_len);
+ size_t msglen = opp->file_len + 22 + sizeof (errbuf);
+ char *msg = xmalloc (msglen);
+ snprintf (msg, msglen, "Cannot open file '%s': %s", path,
+ gf_strerror (errno, errbuf, sizeof (errbuf)));
generate_error (&opp->common, LIBERROR_OS, msg);
+ free (msg);
+ free (path);
goto cleanup;
}
/* Create the unit structure. */
- u->file = get_mem (opp->file_len);
if (u->unit_number != opp->common.unit)
internal_error (&opp->common, "Unit number changed");
u->s = s;
if (flags->position == POSITION_APPEND)
{
if (sseek (u->s, 0, SEEK_END) < 0)
- generate_error (&opp->common, LIBERROR_OS, NULL);
+ {
+ generate_error (&opp->common, LIBERROR_OS, NULL);
+ goto cleanup;
+ }
u->endfile = AT_ENDFILE;
}
else
{
u->flags.has_recl = 0;
- u->recl = max_offset;
+ u->recl = default_recl;
if (compile_options.max_subrecord_length)
{
u->recl_subrecord = compile_options.max_subrecord_length;
if (flags->access == ACCESS_STREAM)
{
u->maxrec = max_offset;
- u->recl = 1;
+ /* F2018 (N2137) 12.10.2.26: If the connection is for stream
+ access recl is assigned the value -2. */
+ u->recl = -2;
u->bytes_left = 1;
u->strm_pos = stell (u->s) + 1;
}
- memmove (u->file, opp->file, opp->file_len);
- u->file_len = opp->file_len;
+ u->filename = fc_strdup (opp->file, opp->file_len);
/* Curiously, the standard requires that the
position specifier be ignored for new files so a newly connected
test_endfile (u);
if (flags->status == STATUS_SCRATCH && opp->file != NULL)
- free_mem (opp->file);
+ free (opp->file);
if (flags->form == FORM_FORMATTED)
{
/* Free memory associated with a temporary filename. */
if (flags->status == STATUS_SCRATCH && opp->file != NULL)
- free_mem (opp->file);
+ free (opp->file);
fail:
modes or closing what is there now and opening the new file. */
static void
-already_open (st_parameter_open *opp, gfc_unit * u, unit_flags * flags)
+already_open (st_parameter_open *opp, gfc_unit *u, unit_flags *flags)
{
if ((opp->common.flags & IOPARM_OPEN_HAS_FILE) == 0)
{
if (!compare_file_filename (u, opp->file, opp->file_len))
{
-#if !HAVE_UNLINK_OPEN_FILE
- char *path = NULL;
- if (u->file && u->flags.status == STATUS_SCRATCH)
- {
- path = (char *) gfc_alloca (u->file_len + 1);
- unpack_filename (path, u->file, u->file_len);
- }
-#endif
-
- if (sclose (u->s) == FAILURE)
+ if (sclose (u->s) == -1)
{
unlock_unit (u);
generate_error (&opp->common, LIBERROR_OS,
}
u->s = NULL;
- if (u->file)
- free_mem (u->file);
- u->file = NULL;
- u->file_len = 0;
-
+
#if !HAVE_UNLINK_OPEN_FILE
- if (path != NULL)
- unlink (path);
+ if (u->filename && u->flags.status == STATUS_SCRATCH)
+ remove (u->filename);
#endif
+ free (u->filename);
+ u->filename = NULL;
u = new_unit (opp, u, flags);
if (u != NULL)
library_start (&opp->common);
/* Decode options. */
+ flags.readonly = !(cf & IOPARM_OPEN_HAS_READONLY) ? 0 : opp->readonly;
flags.access = !(cf & IOPARM_OPEN_HAS_ACCESS) ? ACCESS_UNSPECIFIED :
find_option (&opp->common, opp->access, opp->access_len,
find_option (&opp->common, opp->action, opp->action_len,
action_opt, "Bad ACTION parameter in OPEN statement");
+ flags.cc = !(cf & IOPARM_OPEN_HAS_CC) ? CC_UNSPECIFIED :
+ find_option (&opp->common, opp->cc, opp->cc_len,
+ cc_opt, "Bad CARRIAGECONTROL parameter in OPEN statement");
+
+ flags.share = !(cf & IOPARM_OPEN_HAS_SHARE) ? SHARE_UNSPECIFIED :
+ find_option (&opp->common, opp->share, opp->share_len,
+ share_opt, "Bad SHARE parameter in OPEN statement");
+
flags.blank = !(cf & IOPARM_OPEN_HAS_BLANK) ? BLANK_UNSPECIFIED :
find_option (&opp->common, opp->blank, opp->blank_len,
blank_opt, "Bad BLANK parameter in OPEN statement");
conv = compile_options.convert;
}
- /* We use big_endian, which is 0 on little-endian machines
- and 1 on big-endian machines. */
switch (conv)
{
case GFC_CONVERT_NATIVE:
break;
case GFC_CONVERT_BIG:
- conv = big_endian ? GFC_CONVERT_NATIVE : GFC_CONVERT_SWAP;
+ conv = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? GFC_CONVERT_NATIVE : GFC_CONVERT_SWAP;
break;
case GFC_CONVERT_LITTLE:
- conv = big_endian ? GFC_CONVERT_SWAP : GFC_CONVERT_NATIVE;
+ conv = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? GFC_CONVERT_SWAP : GFC_CONVERT_NATIVE;
break;
default:
flags.convert = conv;
- if (opp->common.unit < 0)
- generate_error (&opp->common, LIBERROR_BAD_OPTION,
- "Bad unit number in OPEN statement");
-
if (flags.position != POSITION_UNSPECIFIED
&& flags.access == ACCESS_DIRECT)
generate_error (&opp->common, LIBERROR_BAD_OPTION,
"Cannot use POSITION with direct access files");
+ if (flags.readonly
+ && flags.action != ACTION_UNSPECIFIED && flags.action != ACTION_READ)
+ generate_error (&opp->common, LIBERROR_BAD_OPTION,
+ "ACTION conflicts with READONLY in OPEN statement");
+
if (flags.access == ACCESS_APPEND)
{
if (flags.position != POSITION_UNSPECIFIED
if ((opp->common.flags & IOPARM_LIBRETURN_MASK) == IOPARM_LIBRETURN_OK)
{
- u = find_or_create_unit (opp->common.unit);
+ if ((opp->common.flags & IOPARM_OPEN_HAS_NEWUNIT))
+ opp->common.unit = newunit_alloc ();
+ else if (opp->common.unit < 0)
+ {
+ u = find_unit (opp->common.unit);
+ if (u == NULL) /* Negative unit and no NEWUNIT-created unit found. */
+ {
+ generate_error (&opp->common, LIBERROR_BAD_OPTION,
+ "Bad unit number in OPEN statement");
+ library_end ();
+ return;
+ }
+ }
+ if (u == NULL)
+ u = find_or_create_unit (opp->common.unit);
if (u->s == NULL)
{
u = new_unit (opp, u, &flags);
else
already_open (opp, u, &flags);
}
-
+
+ if ((opp->common.flags & IOPARM_OPEN_HAS_NEWUNIT)
+ && (opp->common.flags & IOPARM_LIBRETURN_MASK) == IOPARM_LIBRETURN_OK)
+ *opp->newunit = opp->common.unit;
+
library_end ();
}
projects / gcc.git / blobdiff