2008-01-19 Jerry DeLisle <jvdelisle@gcc.gnu.org>

	* io/inquire.c (inquire_via_unit): If a unit is opened, return values
	according to the open action for DIRECT, FORMATTED, and	UNFORMATTED.
	(inquire_via_filename): Return "UNKNOWN" for SEQUENTIAL, DIRECT,
	FORAMATTED, and UNFORMATTED inquiries.
	* io/unix.c (inquire_sequential): Return "UNKNOWN" when appropriate
	for files that are not opened. (inquire_direct): Same.
	(inquire_formatted): Same.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@131672 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 25e239a..f2c5a43 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,13 @@
+2008-01-19  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       * io/inquire.c (inquire_via_unit): If a unit is opened, return values
+       according to the open action for DIRECT, FORMATTED, and UNFORMATTED.
+       (inquire_via_filename): Return "UNKNOWN" for SEQUENTIAL, DIRECT,
+       FORAMATTED, and UNFORMATTED inquiries.
+       * io/unix.c (inquire_sequential): Return "UNKNOWN" when appropriate
+       for files that are not opened. (inquire_direct): Same.
+       (inquire_formatted): Same.
+       
 2008-01-18  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        * io/transfer.c (formatted_transfer_scalar): Set max_pos to the greater

diff --git a/libgfortran/io/inquire.c b/libgfortran/io/inquire.c
index 493b223..ec46285 100644 (file)
--- a/libgfortran/io/inquire.c
+++ b/libgfortran/io/inquire.c
@@ -99,21 +99,39 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
       if (u == NULL)
        p = inquire_sequential (NULL, 0);
       else
-       {
-          /* disallow an open direct access file to be accessed sequentially */
-          if (u->flags.access == ACCESS_DIRECT)
-            p = "NO";
-          else   
-            p = inquire_sequential (u->file, u->file_len);
-       }
+       switch (u->flags.access)
+         {
+         case ACCESS_DIRECT:
+         case ACCESS_STREAM:
+           p = "NO";
+           break;
+         case ACCESS_SEQUENTIAL:
+           p = "YES";
+           break;
+         default:
+           internal_error (&iqp->common, "inquire_via_unit(): Bad access");
+         }
 
       cf_strcpy (iqp->sequential, iqp->sequential_len, p);
     }
 
   if ((cf & IOPARM_INQUIRE_HAS_DIRECT) != 0)
     {
-      p = (u == NULL) ? inquire_direct (NULL, 0) :
-       inquire_direct (u->file, u->file_len);
+      if (u == NULL)
+       p = inquire_direct (NULL, 0);
+      else
+       switch (u->flags.access)
+         {
+         case ACCESS_SEQUENTIAL:
+         case ACCESS_STREAM:
+           p = "NO";
+           break;
+         case ACCESS_DIRECT:
+           p = "YES";
+           break;
+         default:
+           internal_error (&iqp->common, "inquire_via_unit(): Bad access");
+         }
 
       cf_strcpy (iqp->direct, iqp->direct_len, p);
     }
@@ -140,16 +158,40 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
 
   if ((cf & IOPARM_INQUIRE_HAS_FORMATTED) != 0)
     {
-      p = (u == NULL) ? inquire_formatted (NULL, 0) :
-       inquire_formatted (u->file, u->file_len);
+      if (u == NULL)
+       p = inquire_formatted (NULL, 0);
+      else
+       switch (u->flags.form)
+         {
+         case FORM_FORMATTED:
+           p = "YES";
+           break;
+         case FORM_UNFORMATTED:
+           p = "NO";
+           break;
+         default:
+           internal_error (&iqp->common, "inquire_via_unit(): Bad form");
+         }
 
       cf_strcpy (iqp->formatted, iqp->formatted_len, p);
     }
 
   if ((cf & IOPARM_INQUIRE_HAS_UNFORMATTED) != 0)
     {
-      p = (u == NULL) ? inquire_unformatted (NULL, 0) :
-       inquire_unformatted (u->file, u->file_len);
+      if (u == NULL)
+       p = inquire_unformatted (NULL, 0);
+      else
+       switch (u->flags.form)
+         {
+         case FORM_FORMATTED:
+           p = "NO";
+           break;
+         case FORM_UNFORMATTED:
+           p = "YES";
+           break;
+         default:
+           internal_error (&iqp->common, "inquire_via_unit(): Bad form");
+         }
 
       cf_strcpy (iqp->unformatted, iqp->unformatted_len, p);
     }
@@ -359,13 +401,13 @@ inquire_via_filename (st_parameter_inquire *iqp)
 
   if ((cf & IOPARM_INQUIRE_HAS_SEQUENTIAL) != 0)
     {
-      p = inquire_sequential (iqp->file, iqp->file_len);
+      p = "UNKNOWN";
       cf_strcpy (iqp->sequential, iqp->sequential_len, p);
     }
 
   if ((cf & IOPARM_INQUIRE_HAS_DIRECT) != 0)
     {
-      p = inquire_direct (iqp->file, iqp->file_len);
+      p = "UNKNOWN";
       cf_strcpy (iqp->direct, iqp->direct_len, p);
     }
 
@@ -374,13 +416,13 @@ inquire_via_filename (st_parameter_inquire *iqp)
 
   if ((cf & IOPARM_INQUIRE_HAS_FORMATTED) != 0)
     {
-      p = inquire_formatted (iqp->file, iqp->file_len);
+      p = "UNKNOWN";
       cf_strcpy (iqp->formatted, iqp->formatted_len, p);
     }
 
   if ((cf & IOPARM_INQUIRE_HAS_UNFORMATTED) != 0)
     {
-      p = inquire_unformatted (iqp->file, iqp->file_len);
+      p = "UNKNOWN";
       cf_strcpy (iqp->unformatted, iqp->unformatted_len, p);
     }
 

diff --git a/libgfortran/io/unix.c b/libgfortran/io/unix.c
index 91d5adb..d33c110 100644 (file)
--- a/libgfortran/io/unix.c
+++ b/libgfortran/io/unix.c
@@ -1806,7 +1806,7 @@ inquire_sequential (const char *string, int len)
 
   if (S_ISREG (statbuf.st_mode) ||
       S_ISCHR (statbuf.st_mode) || S_ISFIFO (statbuf.st_mode))
-    return yes;
+    return unknown;
 
   if (S_ISDIR (statbuf.st_mode) || S_ISBLK (statbuf.st_mode))
     return no;
@@ -1829,7 +1829,7 @@ inquire_direct (const char *string, int len)
     return unknown;
 
   if (S_ISREG (statbuf.st_mode) || S_ISBLK (statbuf.st_mode))
-    return yes;
+    return unknown;
 
   if (S_ISDIR (statbuf.st_mode) ||
       S_ISCHR (statbuf.st_mode) || S_ISFIFO (statbuf.st_mode))
@@ -1855,7 +1855,7 @@ inquire_formatted (const char *string, int len)
   if (S_ISREG (statbuf.st_mode) ||
       S_ISBLK (statbuf.st_mode) ||
       S_ISCHR (statbuf.st_mode) || S_ISFIFO (statbuf.st_mode))
-    return yes;
+    return unknown;
 
   if (S_ISDIR (statbuf.st_mode))
     return no;