OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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

Browse Source 
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
This commit is contained in:
Tobias Burnus 2014-02-21 08:37:06 +01:00 committed by Tobias Burnus
parent 91d6f071fb
commit 76a4b7ad2d
4 changed files with 61 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
gcc/testsuite/ChangeLog
View File

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

29
gcc/testsuite/gfortran.dg/inquire_16.f90 Normal file
View File

@ -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

7
libgfortran/ChangeLog
View File

@ -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>

46
libgfortran/io/inquire.c
View File

@ -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");