[patch, libfortran] PR34795 inquire statement , direct= specifier incorrectly returns YES

[Jerry DeLisle <jvdelisle at verizon dot net>]

:ADDPATCH fortran:

This patch modifies gfortran behavior for inquire.

The specifiers DIRECT=, FORMATTED=, UNFORMATTED=, and SEQUENTIAL answer the 
question whether a given file "may" be opened with the given specifier.

This implies that the given file or unit is not already opened.

The patch addresses the case where the files are already opened in which case we 
can query the unit for the actual mode and return "YES","NO", "FORMATTED", or 
"UNFORMATTED" accordingly.

SEQUENTIAL= was already handled this way.

Regression tested on X86-64-Linux.  We have no existing test case that is 
affected by this change.  A new test case is provided.

This could ripple to users applications if they relied on previous behavior.  I 
will add that using these on opened files is not well addressed in the standard 
if at all.  Again, the implication is that the file is not already opened.

With the patch, gfortran is in agreement with Intel and Sun behavior.

OK for trunk?

Jerry

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=.

PS Is the patch tracker working any more?
Index: inquire.c
===================================================================
--- inquire.c	(revision 131641)
+++ inquire.c	(working copy)
@@ -100,7 +100,6 @@ inquire_via_unit (st_parameter_inquire *
 	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   
@@ -112,8 +111,15 @@ inquire_via_unit (st_parameter_inquire *
 
   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
+	{
+	  if (u->flags.access == ACCESS_SEQUENTIAL)
+	    p = "NO";
+	  else
+	    p = inquire_direct (u->file, u->file_len);
+	}
 
       cf_strcpy (iqp->direct, iqp->direct_len, p);
     }
@@ -140,16 +146,40 @@ inquire_via_unit (st_parameter_inquire *
 
   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);
     }

! { dg-do run }
! PR34795 inquire statement , direct= specifier incorrectly returns YES
! Test case from PR, modified by Jerry DeLisle  <jvdelisle@gcc.gnu.org
program testinquire
implicit none
character drct*7, acc*12, frmt*12
logical opn

inquire(unit=6, direct=drct, opened=opn, access=acc)
if (drct.ne."NO" .and. .not.opn .and. acc.ne."SEQUENTIAL") call abort

inquire(unit=10, direct=drct, opened=opn, access=acc)
if (drct.ne."UNKNOWN" .and. opn .and. acc.ne."UNDEFINED") call abort

inquire(unit=10, direct=drct, opened=opn, access=acc, formatted=frmt)
if (drct.ne."UNKNOWN" .and. opn .and. acc.ne."UNDEFINED") call abort
if (frmt.ne."UNKNOWN") call abort

open(unit=19,file='testfile',status='replace',err=170,form="formatted")
inquire(unit=19, direct=drct, opened=opn, access=acc,formatted=frmt)
if (drct.ne."NO" .and. .not.opn .and. acc.ne."SEQUENTIAL") call abort
close(19)

open(unit=19,file='testfile',status='replace',err=170,form="unformatted")
inquire(unit=19, direct=drct, opened=opn, access=acc,formatted=frmt)
if (drct.ne."NO" .and. .not.opn .and. acc.ne."SEQUENTIAL") call abort
close(19)
       
open(unit=19,file='testfile',status='replace',err=170,form="formatted")
inquire(unit=19, direct=drct, opened=opn, access=acc,unformatted=frmt)
if (drct.ne."NO" .and. .not.opn .and. acc.ne."SEQUENTIAL") call abort
close(19)

open(unit=19,file='testfile',status='replace',err=170,form="unformatted")
inquire(unit=19, direct=drct, opened=opn, access=acc,unformatted=frmt)
if (drct.ne."NO" .and. .not.opn .and. acc.ne."SEQUENTIAL") call abort
close(19)
      
open(unit=19,file='testdirect.f',status='OLD',err=170)
inquire(unit=19, direct=drct, opened=opn, access=acc)
if (drct.ne."NO" .and. .not.opn .and. acc.ne."SEQUENTIAL") call abort
close(19)

open(unit=19,file='testfile',status='replace',err=170,access='SEQUENTIAL')
inquire(unit=19, direct=drct, opened=opn, access=acc)
if (drct.ne."NO" .and. .not.opn .and. acc.ne."SEQUENTIAL") call abort
close(19)

open(unit=19,file='testfile',status='replace',err=170,form='UNFORMATTED',access='DIRECT',recl=72)
inquire(unit=19, direct=drct, opened=opn, access=acc)
if (drct.ne."YES" .and. .not.opn .and. acc.ne."DIRECT") call abort
close(19, status="delete")
stop

170   write(*,*) "ERROR: unable to open testdirect.f"
end