PR 78534, 83704 Handle large formatted I/O
[gcc.git] / libgfortran / io / open.c
index 0a2fda9d4761bbb07b86734591fbfa5f164cd821..05aac8f6a8b8de72c3fb8db6fc69e62c809d4734 100644 (file)
@@ -1,4 +1,4 @@
-/* Copyright (C) 2002-2015 Free Software Foundation, Inc.
+/* Copyright (C) 2002-2018 Free Software Foundation, Inc.
    Contributed by Andy Vaught
    F2003 I/O support contributed by Jerry DeLisle
 
@@ -33,7 +33,6 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 
 #include <string.h>
 #include <errno.h>
-#include <stdlib.h>
 
 
 static const st_option access_opt[] = {
@@ -52,6 +51,21 @@ static const st_option action_opt[] =
   { 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},
@@ -154,7 +168,7 @@ static const st_option async_opt[] =
    AT_ENDFILE.  */
 
 static void
-test_endfile (gfc_unit * u)
+test_endfile (gfc_unit *u)
 {
   if (u->endfile == NO_ENDFILE)
     { 
@@ -169,7 +183,7 @@ test_endfile (gfc_unit * u)
    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.  */
 
@@ -195,6 +209,14 @@ edit_modes (st_parameter_open *opp, gfc_unit * u, unit_flags * flags)
     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 &&
@@ -307,7 +329,7 @@ edit_modes (st_parameter_open *opp, gfc_unit * u, unit_flags * flags)
 /* 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;
@@ -330,6 +352,16 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags)
   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
@@ -502,34 +534,12 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags)
   s = open_external (opp, flags);
   if (s == NULL)
     {
+      char errbuf[256];
       char *path = fc_strdup (opp->file, opp->file_len);
-      size_t msglen = opp->file_len + 51;
+      size_t msglen = opp->file_len + 22 + sizeof (errbuf);
       char *msg = xmalloc (msglen);
-
-      switch (errno)
-       {
-       case ENOENT: 
-         snprintf (msg, msglen, "File '%s' does not exist", path);
-         break;
-
-       case EEXIST:
-         snprintf (msg, msglen, "File '%s' already exists", path);
-         break;
-
-       case EACCES:
-         snprintf (msg, msglen, 
-                   "Permission denied trying to open file '%s'", path);
-         break;
-
-       case EISDIR:
-         snprintf (msg, msglen, "'%s' is a directory", path);
-         break;
-
-       default:
-         free (msg);
-         msg = NULL;
-       }
-
+      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);
@@ -576,7 +586,7 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags)
   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;
@@ -612,7 +622,9 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags)
   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;
     }
@@ -661,7 +673,7 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags)
    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)
     {
@@ -686,7 +698,7 @@ already_open (st_parameter_open *opp, gfc_unit * u, unit_flags * flags)
  
 #if !HAVE_UNLINK_OPEN_FILE
       if (u->filename && u->flags.status == STATUS_SCRATCH)
-       unlink (u->filename);
+       remove (u->filename);
 #endif
      free (u->filename);
      u->filename = NULL;
@@ -717,6 +729,7 @@ st_open (st_parameter_open *opp)
   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,
@@ -726,6 +739,14 @@ st_open (st_parameter_open *opp)
     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");
@@ -786,8 +807,6 @@ st_open (st_parameter_open *opp)
        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:
@@ -795,11 +814,11 @@ st_open (st_parameter_open *opp)
       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:
@@ -814,6 +833,11 @@ st_open (st_parameter_open *opp)
     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
@@ -834,7 +858,7 @@ st_open (st_parameter_open *opp)
   if ((opp->common.flags & IOPARM_LIBRETURN_MASK) == IOPARM_LIBRETURN_OK)
     {
       if ((opp->common.flags & IOPARM_OPEN_HAS_NEWUNIT))
-       opp->common.unit = get_unique_unit_number(opp);
+       opp->common.unit = newunit_alloc ();
       else if (opp->common.unit < 0)
        {
          u = find_unit (opp->common.unit);