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