PR 78534, 83704 Handle large formatted I/O

[gcc.git] / libgfortran / io / open.c

diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c
index d074b020d8113c8d858ce3e0cbcf3f874162b7eb..05aac8f6a8b8de72c3fb8db6fc69e62c809d4734 100644 (file)
--- a/libgfortran/io/open.c
+++ b/libgfortran/io/open.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2002-2016 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
@@ -554,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;
@@ -590,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;
     }
@@ -639,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)
     {
@@ -695,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,
@@ -704,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");
@@ -764,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:
@@ -773,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:
@@ -792,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
@@ -812,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->common);
+       opp->common.unit = newunit_alloc ();
       else if (opp->common.unit < 0)
        {
          u = find_unit (opp->common.unit);