re PR fortran/60286 (INQUIRE reports STDOUT as not writable)

2014-02-21  Tobias Burnus  <burnus@net-b.de>

        PR fortran/60286
        * libgfortran/io/inquire.c (yes, no): New static const char
        * vars.
        (inquire_via_unit): Use them. Use OPEN mode instead of using
        POSIX's access to query about write=, read= and readwrite=.

2014-02-21  Tobias Burnus  <burnus@net-b.de>

        PR fortran/60286
        * gfortran.dg/inquire_16.f90: New.

From-SVN: r207979

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 84e1ba38723117a5985c8120092bb2a6abbeac17..ec294e76c3962bac49fe62591f18824668ae5cfe 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2014-02-21  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/60286
+       * gfortran.dg/inquire_16.f90: New.
+
 2014-02-20  Sandra Loosemore  <sandra@codesourcery.com>
 
        * gcc.target/nios2/biggot-1.c: New.

diff --git a/gcc/testsuite/gfortran.dg/inquire_16.f90 b/gcc/testsuite/gfortran.dg/inquire_16.f90
new file mode 100644 (file)
index 0000000..b52e23d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/inquire_16.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+!
+! PR fortran/60286
+!
+! Contributed by  Alexander Vogt
+!
+program test_inquire
+  use, intrinsic :: ISO_Fortran_env
+  implicit none
+  character(len=20) :: s_read, s_write, s_readwrite
+
+  inquire(unit=input_unit, read=s_read, write=s_write, &
+          readwrite=s_readwrite)
+  if (s_read /= "YES" .or. s_write /= "NO" .or. s_readwrite /="NO") then
+    call abort()
+  endif
+
+  inquire(unit=output_unit, read=s_read, write=s_write, &
+          readwrite=s_readwrite)
+  if (s_read /= "NO" .or. s_write /= "YES" .or. s_readwrite /="NO") then
+    call abort()
+  endif
+
+  inquire(unit=error_unit, read=s_read, write=s_write, &
+          readwrite=s_readwrite)
+  if (s_read /= "NO" .or. s_write /= "YES" .or. s_readwrite /="NO") then
+    call abort()
+  endif
+end program test_inquire

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 6cf885f947f533ec64f9046ede9f2a211281cc05..e39607e56734bc5e64c18384ea6bcd26a89f29c4 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,10 @@
+2014-02-21  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/60286
+       * libgfortran/io/inquire.c (yes, no): New static const char vars.
+       (inquire_via_unit): Use them. Use OPEN mode instead of using
+       POSIX's access to query about write=, read= and readwrite=.
+
 2014-01-20  Jerry DeLisle  <jvdelisle@gcc.gnu>
            Dominique d'Humieres  <dominiq@lps.ens.fr>
 

diff --git a/libgfortran/io/inquire.c b/libgfortran/io/inquire.c
index b12ee510085a16b87af7f7ce3b49ea5b485c55a3..6801d01b0847584bf5cda9a17026ccc40aae91d1 100644 (file)
--- a/libgfortran/io/inquire.c
+++ b/libgfortran/io/inquire.c
@@ -30,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. */
@@ -130,10 +130,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 +151,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 +191,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 +211,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");
@@ -266,10 +266,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 +336,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 +423,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");
@@ -499,25 +499,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);
     }
 
@@ -552,10 +546,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");