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 4d03161cbf89fb1b87ec20b813816337d7fed288..047be39ec7af0f26e47620288422ddb8054aefa8 100644 (file)
--- a/libgfortran/io/inquire.c
+++ b/libgfortran/io/inquire.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2002-2014 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).
@@ -36,24 +36,21 @@ 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);
@@ -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
     }
 
@@ -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;
@@ -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)
@@ -566,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:
@@ -585,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)
@@ -677,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)