diff mbox

[Fortran] PR602864 - fix INQUIRE for write= with stdout/stdin/stderr

Message ID 20140220125457.GA22026@physik.fu-berlin.de
State New
Headers show

Commit Message

Tobias Burnus Feb. 20, 2014, 12:54 p.m. UTC
A rather simple patch.

Build and regtested on x86-64-gnu-linux.
OK for the trunk?

Tobias

Comments

Janus Weil Feb. 20, 2014, 5:51 p.m. UTC | #1
Hi Tobias,

> A rather simple patch.
>
> 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?

Cheers,
Janus
diff mbox

Patch

2014-02-20  Tobias Burnus  <burnus@net-b.de>

	PR fortran/602864
	* libgfortran/io/inquire.c (yes, no): New static const char vars.
	(inquire_via_unit): Use them. Return proper value for
	write=, read= and readwrite= for stdin/stdout/stderr.

2014-02-20  Tobias Burnus  <burnus@net-b.de>

	PR fortran/602864
	* 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/602864
+!
+! 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..3f8497a 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,7 +499,14 @@  inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
 
   if ((cf & IOPARM_INQUIRE_HAS_READ) != 0)
     {
-      p = (u == NULL) ? inquire_read (NULL, 0) :
+      if (!u)
+	inquire_read (NULL, 0);
+      else if (u->unit_number == options.stdin_unit)
+	p = yes;
+      else if (u->unit_number == options.stdout_unit
+	       || u->unit_number == options.stderr_unit)
+	p = no;
+      else
 	inquire_read (u->file, u->file_len);
 
       cf_strcpy (iqp->read, iqp->read_len, p);
@@ -507,7 +514,14 @@  inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
 
   if ((cf & IOPARM_INQUIRE_HAS_WRITE) != 0)
     {
-      p = (u == NULL) ? inquire_write (NULL, 0) :
+      if (!u)
+	inquire_write (NULL, 0);
+      else if (u->unit_number == options.stdin_unit)
+	p = no;
+      else if (u->unit_number == options.stdout_unit
+	       || u->unit_number == options.stderr_unit)
+	p = yes;
+      else
 	inquire_write (u->file, u->file_len);
 
       cf_strcpy (iqp->write, iqp->write_len, p);
@@ -515,7 +529,13 @@  inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
 
   if ((cf & IOPARM_INQUIRE_HAS_READWRITE) != 0)
     {
-      p = (u == NULL) ? inquire_readwrite (NULL, 0) :
+      if (!u)
+	inquire_readwrite (NULL, 0);
+      else if (u->unit_number == options.stdin_unit
+	       || u->unit_number == options.stdout_unit
+	       || u->unit_number == options.stderr_unit)
+	p = no;
+      else
 	inquire_readwrite (u->file, u->file_len);
 
       cf_strcpy (iqp->readwrite, iqp->readwrite_len, p);
@@ -552,10 +572,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");