projects / gcc.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
PR 78534, 83704 Handle large formatted I/O
[gcc.git] / libgfortran / io / inquire.c
diff --git a/libgfortran/io/inquire.c b/libgfortran/io/inquire.c
index d91982a65b7134e4d0786819a811062461f7f81d..047be39ec7af0f26e47620288422ddb8054aefa8 100644 (file)
--- a/libgfortran/io/inquire.c
+++ b/libgfortran/io/inquire.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2002-2013 Free Software Foundation, Inc.
+/* Copyright (C) 2002-2018 Free Software Foundation, Inc.
    Contributed by Andy Vaught
 
 This file is part of the GNU Fortran runtime library (libgfortran).
@@ -30,30 +30,27 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #include <string.h>
 
 
-static const char undefined[] = "UNDEFINED";
+static const char yes[] = "YES", no[] = "NO", undefined[] = "UNDEFINED";
 
 
 /* inquire_via_unit()-- Inquiry via unit number.  The unit might not exist. */
 
 static void
-inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
+inquire_via_unit (st_parameter_inquire *iqp, gfc_unit *u)
 {
   const char *p;
   GFC_INTEGER_4 cf = iqp->common.flags;
 
-  if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0)
-    {
-      *iqp->exist = (iqp->common.unit >= 0
-                    && iqp->common.unit <= GFC_INTEGER_4_HUGE);
+  if (iqp->common.unit == GFC_INTERNAL_UNIT ||
+       iqp->common.unit == GFC_INTERNAL_UNIT4 ||
+       (u != NULL && u->internal_unit_kind != 0))
+    generate_error (&iqp->common, LIBERROR_INQUIRE_INTERNAL_UNIT, NULL);
 
-      if ((cf & IOPARM_INQUIRE_HAS_FILE) == 0)
-       {
-         if (!(*iqp->exist))
-           *iqp->common.iostat = LIBERROR_BAD_UNIT;
-         *iqp->exist = *iqp->exist
-                       && (*iqp->common.iostat != LIBERROR_BAD_UNIT);
-       }
-    }
+  if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0)
+    *iqp->exist = (u != NULL &&
+                  iqp->common.unit != GFC_INTERNAL_UNIT &&
+                  iqp->common.unit != GFC_INTERNAL_UNIT4)
+               || (iqp->common.unit >= 0);
 
   if ((cf & IOPARM_INQUIRE_HAS_OPENED) != 0)
     *iqp->opened = (u != NULL);
@@ -80,10 +77,10 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
                memset (&iqp->name[tmplen], ' ', iqp->name_len - tmplen);
            }
          else /* If ttyname does not work, go with the default.  */
-           fstrcpy (iqp->name, iqp->name_len, u->file, u->file_len);
+           cf_strcpy (iqp->name, iqp->name_len, u->filename);
        }
       else
-       fstrcpy (iqp->name, iqp->name_len, u->file, u->file_len);
+       cf_strcpy (iqp->name, iqp->name_len, u->filename);
 #elif defined __MINGW32__
       if (u->unit_number == options.stdin_unit)
        fstrcpy (iqp->name, iqp->name_len, "CONIN$", sizeof("CONIN$"));
@@ -92,9 +89,9 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
       else if (u->unit_number == options.stderr_unit)
        fstrcpy (iqp->name, iqp->name_len, "CONERR$", sizeof("CONERR$"));
       else
-       fstrcpy (iqp->name, iqp->name_len, u->file, u->file_len);
+       cf_strcpy (iqp->name, iqp->name_len, u->filename);
 #else
-    fstrcpy (iqp->name, iqp->name_len, u->file, u->file_len);
+      cf_strcpy (iqp->name, iqp->name_len, u->filename);
 #endif
     }
 
@@ -130,10 +127,10 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
          {
          case ACCESS_DIRECT:
          case ACCESS_STREAM:
-           p = "NO";
+           p = no;
            break;
          case ACCESS_SEQUENTIAL:
-           p = "YES";
+           p = yes;
            break;
          default:
            internal_error (&iqp->common, "inquire_via_unit(): Bad access");
@@ -151,10 +148,10 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
          {
          case ACCESS_SEQUENTIAL:
          case ACCESS_STREAM:
-           p = "NO";
+           p = no;
            break;
          case ACCESS_DIRECT:
-           p = "YES";
+           p = yes;
            break;
          default:
            internal_error (&iqp->common, "inquire_via_unit(): Bad access");
@@ -191,10 +188,10 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
        switch (u->flags.form)
          {
          case FORM_FORMATTED:
-           p = "YES";
+           p = yes;
            break;
          case FORM_UNFORMATTED:
-           p = "NO";
+           p = no;
            break;
          default:
            internal_error (&iqp->common, "inquire_via_unit(): Bad form");
@@ -211,10 +208,10 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
        switch (u->flags.form)
          {
          case FORM_FORMATTED:
-           p = "NO";
+           p = no;
            break;
          case FORM_UNFORMATTED:
-           p = "YES";
+           p = yes;
            break;
          default:
            internal_error (&iqp->common, "inquire_via_unit(): Bad form");
@@ -224,7 +221,9 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
     }
 
   if ((cf & IOPARM_INQUIRE_HAS_RECL_OUT) != 0)
-    *iqp->recl_out = (u != NULL) ? u->recl : 0;
+    /* F2018 (N2137) 12.10.2.26: If there is no connection, recl is
+       assigned the value -1.  */
+    *iqp->recl_out = (u != NULL) ? u->recl : -1;
 
   if ((cf & IOPARM_INQUIRE_HAS_STRM_POS_OUT) != 0)
     *iqp->strm_pos_out = (u != NULL) ? u->strm_pos : 0;
@@ -266,10 +265,10 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
        switch (u->flags.pad)
          {
          case PAD_YES:
-           p = "YES";
+           p = yes;
            break;
          case PAD_NO:
-           p = "NO";
+           p = no;
            break;
          default:
            internal_error (&iqp->common, "inquire_via_unit(): Bad pad");
@@ -336,10 +335,10 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
            switch (u->flags.async)
            {
              case ASYNC_YES:
-               p = "YES";
+               p = yes;
                break;
              case ASYNC_NO:
-               p = "NO";
+               p = no;
                break;
              default:
                internal_error (&iqp->common, "inquire_via_unit(): Bad async");
@@ -423,10 +422,10 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
              {
              case ACCESS_SEQUENTIAL:
              case ACCESS_DIRECT:
-               p = "NO";
+               p = no;
                break;
              case ACCESS_STREAM:
-               p = "YES";
+               p = yes;
                break;
              default:
                internal_error (&iqp->common, "inquire_via_unit(): Bad pad");
@@ -434,6 +433,58 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
     
          cf_strcpy (iqp->iqstream, iqp->iqstream_len, p);
        }
+
+      if ((cf2 & IOPARM_INQUIRE_HAS_SHARE) != 0)
+       {
+         if (u == NULL)
+           p = "UNKNOWN";
+         else
+           switch (u->flags.share)
+             {
+               case SHARE_DENYRW:
+                 p = "DENYRW";
+                 break;
+               case SHARE_DENYNONE:
+                 p = "DENYNONE";
+                 break;
+               case SHARE_UNSPECIFIED:
+                 p = "NODENY";
+                 break;
+               default:
+                 internal_error (&iqp->common,
+                     "inquire_via_unit(): Bad share");
+                 break;
+             }
+
+         cf_strcpy (iqp->share, iqp->share_len, p);
+       }
+
+      if ((cf2 & IOPARM_INQUIRE_HAS_CC) != 0)
+       {
+         if (u == NULL)
+           p = "UNKNOWN";
+         else
+           switch (u->flags.cc)
+             {
+               case CC_FORTRAN:
+                 p = "FORTRAN";
+                 break;
+               case CC_LIST:
+                 p = "LIST";
+                 break;
+               case CC_NONE:
+                 p = "NONE";
+                 break;
+               case CC_UNSPECIFIED:
+                 p = "UNKNOWN";
+                 break;
+               default:
+                 internal_error (&iqp->common, "inquire_via_unit(): Bad cc");
+                 break;
+             }
+
+         cf_strcpy (iqp->cc, iqp->cc_len, p);
+       }
     }
 
   if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0)
@@ -499,25 +550,19 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
 
   if ((cf & IOPARM_INQUIRE_HAS_READ) != 0)
     {
-      p = (u == NULL) ? inquire_read (NULL, 0) :
-       inquire_read (u->file, u->file_len);
-
+      p = (!u || u->flags.action == ACTION_WRITE) ? no : yes;
       cf_strcpy (iqp->read, iqp->read_len, p);
     }
 
   if ((cf & IOPARM_INQUIRE_HAS_WRITE) != 0)
     {
-      p = (u == NULL) ? inquire_write (NULL, 0) :
-       inquire_write (u->file, u->file_len);
-
+      p = (!u || u->flags.action == ACTION_READ) ? no : yes;
       cf_strcpy (iqp->write, iqp->write_len, p);
     }
 
   if ((cf & IOPARM_INQUIRE_HAS_READWRITE) != 0)
     {
-      p = (u == NULL) ? inquire_readwrite (NULL, 0) :
-       inquire_readwrite (u->file, u->file_len);
-
+      p = (!u || u->flags.action != ACTION_READWRITE) ? no : yes;
       cf_strcpy (iqp->readwrite, iqp->readwrite_len, p);
     }
 
@@ -529,6 +574,7 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
        switch (u->flags.delim)
          {
          case DELIM_NONE:
+         case DELIM_UNSPECIFIED:
            p = "NONE";
            break;
          case DELIM_QUOTE:
@@ -552,10 +598,10 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
        switch (u->flags.pad)
          {
          case PAD_NO:
-           p = "NO";
+           p = no;
            break;
          case PAD_YES:
-           p = "YES";
+           p = yes;
            break;
          default:
            internal_error (&iqp->common, "inquire_via_unit(): Bad pad");
@@ -571,13 +617,12 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
       else
        switch (u->flags.convert)
          {
-           /*  big_endian is 0 for little-endian, 1 for big-endian.  */
          case GFC_CONVERT_NATIVE:
-           p = big_endian ? "BIG_ENDIAN" : "LITTLE_ENDIAN";
+           p = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? "BIG_ENDIAN" : "LITTLE_ENDIAN";
            break;
 
          case GFC_CONVERT_SWAP:
-           p = big_endian ? "LITTLE_ENDIAN" : "BIG_ENDIAN";
+           p = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? "LITTLE_ENDIAN" : "BIG_ENDIAN";
            break;
 
          default:
@@ -590,7 +635,7 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
 
 
 /* inquire_via_filename()-- Inquiry via filename.  This subroutine is
- * only used if the filename is *not* connected to a unit number. */
+   only used if the filename is *not* connected to a unit number. */
 
 static void
 inquire_via_filename (st_parameter_inquire *iqp)
@@ -682,6 +727,12 @@ inquire_via_filename (st_parameter_inquire *iqp)
 
       if ((cf2 & IOPARM_INQUIRE_HAS_IQSTREAM) != 0)
        cf_strcpy (iqp->iqstream, iqp->iqstream_len, "UNKNOWN");
+
+      if ((cf2 & IOPARM_INQUIRE_HAS_SHARE) != 0)
+       cf_strcpy (iqp->share, iqp->share_len, "UNKNOWN");
+
+      if ((cf2 & IOPARM_INQUIRE_HAS_CC) != 0)
+       cf_strcpy (iqp->cc, iqp->cc_len, "UNKNOWN");
     }
 
   if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0)