[patch, fortran] PR48976 INQUIRE with STREAM= not supported

[Jerry DeLisle <jvdelisle at charter dot net>]

Greetings,

The attached patch implements the missing INQUIRE(99, STREAM=str) functionality 
required by the Fortran 2008 Standard.

Regression tested on x86-64.

OK for trunk with test case from the PR?

Regards,

Jerry

2012-12-27  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/48976
	* gfortran.h (gfc_inquire struct): Add pointer for inquire stream.
	* io.c (io_tag): Add tag for inquire stream. (match_inquire_element):
	Add matcher for new tag. (gfc_resolve_inquire): Resolve new tag.
	* ioparm.def: Add new parameter for inquire stream.
	* trans-io.c (gfc_trans_inquire): Add tranlste code for inquire
	stream.

2012-12-27  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libfortran/48976
	* io/inquire.c (inquire_via_unit): Set user stream inquiry variable to
	appropriate value based on unit access method. (inquire_via_filename):
	Since filename is not associated with an open unit, set stream inquiry
	to UNKNOWN.
	* io/io.h: Define inquire stream parameters.

Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 194678)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -2008,7 +2008,8 @@ typedef struct
     *name, *access, *sequential, *direct, *form, *formatted,
     *unformatted, *recl, *nextrec, *blank, *position, *action, *read,
     *write, *readwrite, *delim, *pad, *iolength, *iomsg, *convert, *strm_pos,
-    *asynchronous, *decimal, *encoding, *pending, *round, *sign, *size, *id;
+    *asynchronous, *decimal, *encoding, *pending, *round, *sign, *size, *id,
+    *iqstream;
 
   gfc_st_label *err;
 
Index: gcc/fortran/io.c
===================================================================
--- gcc/fortran/io.c	(revision 194678)
+++ gcc/fortran/io.c	(working copy)
@@ -97,7 +97,8 @@ static const io_tag
 	tag_eor		= {"EOR", " eor =", " %l", BT_UNKNOWN},
 	tag_id		= {"ID", " id =", " %v", BT_INTEGER},
 	tag_pending	= {"PENDING", " pending =", " %v", BT_LOGICAL},
-	tag_newunit	= {"NEWUNIT", " newunit =", " %v", BT_INTEGER};
+	tag_newunit	= {"NEWUNIT", " newunit =", " %v", BT_INTEGER},
+	tag_s_iqstream	= {"STREAM", " stream =", " %v", BT_CHARACTER};
 
 static gfc_dt *current_dt;
 
@@ -3912,6 +3913,7 @@ match_inquire_element (gfc_inquire *inquire)
   RETM m = match_out_tag (&tag_strm_out, &inquire->strm_pos);
   RETM m = match_vtag (&tag_pending, &inquire->pending);
   RETM m = match_vtag (&tag_id, &inquire->id);
+  RETM m = match_vtag (&tag_s_iqstream, &inquire->iqstream);
   RETM return MATCH_NO;
 }
 
@@ -4101,6 +4103,7 @@ gfc_resolve_inquire (gfc_inquire *inquire)
   INQUIRE_RESOLVE_TAG (&tag_pending, inquire->pending);
   INQUIRE_RESOLVE_TAG (&tag_size, inquire->size);
   INQUIRE_RESOLVE_TAG (&tag_s_decimal, inquire->decimal);
+  INQUIRE_RESOLVE_TAG (&tag_s_iqstream, inquire->iqstream);
 #undef INQUIRE_RESOLVE_TAG
 
   if (gfc_reference_st_label (inquire->err, ST_LABEL_TARGET) == FAILURE)
Index: gcc/fortran/ioparm.def
===================================================================
--- gcc/fortran/ioparm.def	(revision 194678)
+++ gcc/fortran/ioparm.def	(working copy)
@@ -88,6 +88,7 @@ IOPARM (inquire, sign,		1 << 4,  char1)
 IOPARM (inquire, pending,	1 << 5,  pint4)
 IOPARM (inquire, size,		1 << 6,  pintio)
 IOPARM (inquire, id,		1 << 7,  pint4)
+IOPARM (inquire, iqstream,	1 << 8,  char1)
 IOPARM (wait,    common,	0,	 common)
 IOPARM (wait,    id,		1 << 7,  pint4)
 #ifndef IOPARM_dt_list_format
Index: gcc/fortran/trans-io.c
===================================================================
--- gcc/fortran/trans-io.c	(revision 194678)
+++ gcc/fortran/trans-io.c	(working copy)
@@ -1364,6 +1364,9 @@ gfc_trans_inquire (gfc_code * code)
   if (p->id)
     mask2 |= set_parameter_ref (&block, &post_block,var, IOPARM_inquire_id,
 				p->id);
+  if (p->iqstream)
+    mask2 |= set_string (&block, &post_block, var, IOPARM_inquire_iqstream,
+			 p->iqstream);
 
   if (mask2)
     mask |= set_parameter_const (&block, var, IOPARM_inquire_flags2, mask2);
Index: libgfortran/io/inquire.c
===================================================================
--- libgfortran/io/inquire.c	(revision 194723)
+++ libgfortran/io/inquire.c	(working copy)
@@ -414,6 +414,27 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_u
 	      *iqp->size = ssize (u->s);
 	    }
 	}
+
+      if ((cf2 & IOPARM_INQUIRE_HAS_STREAM) != 0)
+	{
+	  if (u == NULL)
+	    p = "UNKNOWN";
+	  else
+	    switch (u->flags.access)
+	      {
+	      case ACCESS_SEQUENTIAL:
+	      case ACCESS_DIRECT:
+		p = "NO";
+		break;
+	      case ACCESS_STREAM:
+		p = "YES";
+		break;
+	      default:
+		internal_error (&iqp->common, "inquire_via_unit(): Bad pad");
+	      }
+    
+	  cf_strcpy (iqp->iqstream, iqp->iqstream_len, p);
+	}
     }
 
   if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0)
@@ -659,6 +680,9 @@ inquire_via_filename (st_parameter_inquire *iqp)
 
       if ((cf2 & IOPARM_INQUIRE_HAS_SIZE) != 0)
 	*iqp->size = file_size (iqp->file, iqp->file_len);
+
+      if ((cf2 & IOPARM_INQUIRE_HAS_STREAM) != 0)
+	cf_strcpy (iqp->iqstream, iqp->iqstream_len, "UNKNOWN");
     }
 
   if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0)
Index: libgfortran/io/io.h
===================================================================
--- libgfortran/io/io.h	(revision 194723)
+++ libgfortran/io/io.h	(working copy)
@@ -293,6 +293,7 @@ st_parameter_filepos;
 #define IOPARM_INQUIRE_HAS_PENDING	(1 << 5)
 #define IOPARM_INQUIRE_HAS_SIZE		(1 << 6)
 #define IOPARM_INQUIRE_HAS_ID		(1 << 7)
+#define IOPARM_INQUIRE_HAS_STREAM	(1 << 8)
 
 typedef struct
 {
@@ -326,6 +327,7 @@ typedef struct
   GFC_INTEGER_4 *pending;
   GFC_IO_INT *size;
   GFC_INTEGER_4 *id;
+  CHARACTER1 (iqstream);
 }
 st_parameter_inquire;