Update

[l4.git] / l4 / pkg / libgfortran / lib / contrib / io / inquire.c

diff --git a/l4/pkg/libgfortran/lib/contrib/io/inquire.c b/l4/pkg/libgfortran/lib/contrib/io/inquire.c
index a5423346db99ee8fbef6d2d1a53e3eb431e8e926..a5f362e0f20f7af47dba0ef1a52fed157fa6b1bb 100644 (file)
--- a/l4/pkg/libgfortran/lib/contrib/io/inquire.c
+++ b/l4/pkg/libgfortran/lib/contrib/io/inquire.c
@@ -1,5 +1,4 @@
-/* Copyright (C) 2002, 2003, 2005, 2007, 2009, 2010, 2011
-   Free Software Foundation, Inc.
+/* Copyright (C) 2002-2015 Free Software Foundation, Inc.
    Contributed by Andy Vaught
 
 This file is part of the GNU Fortran runtime library (libgfortran).
@@ -31,7 +30,7 @@ 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. */
@@ -42,19 +41,11 @@ 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)
+    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 >= 0);
 
   if ((cf & IOPARM_INQUIRE_HAS_OPENED) != 0)
     *iqp->opened = (u != NULL);
@@ -81,10 +72,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$"));
@@ -93,9 +84,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
     }
 
@@ -131,10 +122,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");
@@ -152,10 +143,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");
@@ -192,10 +183,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");
@@ -212,10 +203,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");
@@ -267,10 +258,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");
@@ -337,10 +328,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");
@@ -414,6 +405,27 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
              *iqp->size = ssize (u->s);
            }
        }
+
+      if ((cf2 & IOPARM_INQUIRE_HAS_IQSTREAM) != 0)
+       {
+         if (u == NULL)
+           p = "UNKNOWN";
+         else
+           switch (u->flags.access)
+             {
+             case ACCESS_SEQUENTIAL:
+             case ACCESS_DIRECT:
+               p = no;
+               break;
+             case ACCESS_STREAM:
+               p = yes;
+               break;
+             default:
+               internal_error (&iqp->common, "inquire_via_unit(): Bad pad");
+             }
+    
+         cf_strcpy (iqp->iqstream, iqp->iqstream_len, p);
+       }
     }
 
   if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0)
@@ -479,25 +491,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);
     }
 
@@ -509,6 +515,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:
@@ -532,10 +539,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");
@@ -659,6 +666,9 @@ inquire_via_filename (st_parameter_inquire *iqp)
 
       if ((cf2 & IOPARM_INQUIRE_HAS_SIZE) != 0)
        *iqp->size = file_size (iqp->file, iqp->file_len);
+
+      if ((cf2 & IOPARM_INQUIRE_HAS_IQSTREAM) != 0)
+       cf_strcpy (iqp->iqstream, iqp->iqstream_len, "UNKNOWN");
     }
 
   if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0)