From 76a4b7ad2d7d071458a4cb4d8515c14b9abf0d19 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 21 Feb 2014 08:37:06 +0100 Subject: [PATCH] re PR fortran/60286 (INQUIRE reports STDOUT as not writable) 2014-02-21 Tobias Burnus 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 PR fortran/60286 * gfortran.dg/inquire_16.f90: New. From-SVN: r207979 --- gcc/testsuite/ChangeLog | 5 +++ gcc/testsuite/gfortran.dg/inquire_16.f90 | 29 +++++++++++++++ libgfortran/ChangeLog | 7 ++++ libgfortran/io/inquire.c | 46 +++++++++++------------- 4 files changed, 61 insertions(+), 26 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/inquire_16.f90 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 84e1ba38723..ec294e76c39 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2014-02-21 Tobias Burnus + + PR fortran/60286 + * gfortran.dg/inquire_16.f90: New. + 2014-02-20 Sandra Loosemore * 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 index 00000000000..b52e23db6b4 --- /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 6cf885f947f..e39607e5673 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,10 @@ +2014-02-21 Tobias Burnus + + 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 Dominique d'Humieres diff --git a/libgfortran/io/inquire.c b/libgfortran/io/inquire.c index b12ee510085..6801d01b084 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 -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");