Hi Janus,
On Thu, Feb 20, 2014 at 06:51:30PM +0100, Janus Weil wrote:
> > Build and regtested on x86-64-gnu-linux.
> > OK for the trunk?
>
> the patch looks pretty much trivial, int the sense that you just
> hard-wire the expected values for the std* units as a special case. I
> wonder why the 'inquire_read' and 'inquire_write' functions don't
> actually return the correct values?
One can inquire by FILE= name and by UNIT=; inquire_read() is using
the file name - either via FILE= directly or for an opened unit
via u->file; it then calls POSIX's access() function on the file name
to determine the permissions. Obviously, that fails if no file
actually exists.
Thus, simply calling the function won't work - and as all three cases
are slightly different, hardcoding the condition is simplest.
However, I now wonder whether one should also take care of other cases,
where no file name exists - but which could be queried. In that case,
one could simply use the mode in which the file was opened - which
one could do in general for files in the UNIT= mode - contrary to
the FILE= mode. I am in particular thinking of scratch files - they
are often opened, then deleted and only file descriptor remains.
Namely, either unconditionally using for UNIT=:
if ((cf & IOPARM_INQUIRE_HAS_READWRITE) != 0)
p = (u->flags.action == ACTION_READWRITE) ? yes : no;
We probably still need some special case for stdin/stdout/stderr.
Or adding as additional condition:
if (u->flags->status == STATUS_SCRATCH)
p = (u->flags.action == ACTION_READWRITE) ? yes : no;
to also handle SCRATCH correctly.
* Advantage of access(): Gives the true file mode by the OS.
* Advantage of the open mode: Gives the permissions for which the
unit was opened. Also works in corner cases (scratch, stdout, ...).
Simpler code.
I have no idea what users prefer - but when using the unit directly,
the OPEN's ACCTION= mode feels a bit more natural than access().
Thoughts?
What about the new version of the patch?
It was built and regtested on x86-64-gnu-linux.
Tobias
PS: I also fixed the PR number - thanks Uros!
2014-02-20 Tobias Burnus <bur...@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-20 Tobias Burnus <bur...@net-b.de>
PR fortran/60286
* gfortran.dg/inquire_16.f90: New.
diff --git a/gcc/testsuite/gfortran.dg/inquire_16.f90 b/gcc/testsuite/gfortran.dg/inquire_16.f90
new file mode 100644
index 0000000..03b735e
--- /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/io/inquire.c b/libgfortran/io/inquire.c
index b12ee51..6801d01 100644
--- 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");
