From patchwork Thu Dec 27 06:35:50 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Subject: [fortran] PR48976 INQUIRE with STREAM= not supported Date: Wed, 26 Dec 2012 20:35:50 -0000 From: jerry DeLisle X-Patchwork-Id: 208271 Message-Id: <50DBEC46.403@charter.net> To: gfortran Cc: gcc patches 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 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 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;