aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran
diff options
context:
space:
mode:
authorJerry DeLisle <jvdelisle@gcc.gnu.org>2008-05-03 15:11:33 +0000
committerJerry DeLisle <jvdelisle@gcc.gnu.org>2008-05-03 15:11:33 +0000
commitad7ee6f8d5a0fda91de731835f909a3c330db24d (patch)
tree3a2e67ce85966590b4fb8f93a08d35134b0a8ba0 /gcc/fortran
parent1183512494cf8f3ca0b5460808d563ec0f8f14ec (diff)
downloadgcc-ad7ee6f8d5a0fda91de731835f909a3c330db24d.zip
gcc-ad7ee6f8d5a0fda91de731835f909a3c330db24d.tar.gz
gcc-ad7ee6f8d5a0fda91de731835f909a3c330db24d.tar.bz2
re PR fortran/33268 (read ('(f3.3)'), a rejected due to the extra (...))
2008-05-03 Jerry DeLisle <jvdelisle@gcc.gnu.org> PR fortran/33268 * gfortran.h: Add extra_comma pointer to gfc_dt structure. Add iokind to gfc_expr value union. Add io_kind enum to here from io.c. * io.c (gfc_free_dt): Free extra_comma. (gfc_resolve_dt): If an extra comma was encountered and io_unit is type BT_CHARACTER, resolve to format_expr and set default unit. Error if io_kind is M_WRITE. (match_io): Match the extra comma and set new pointer, extra_comma. From-SVN: r134900
Diffstat (limited to 'gcc/fortran')
-rw-r--r--gcc/fortran/ChangeLog11
-rw-r--r--gcc/fortran/gfortran.h10
-rw-r--r--gcc/fortran/io.c71
3 files changed, 77 insertions, 15 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a0755f8..9029fc0 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,14 @@
+2008-05-03 Jerry DeLisle <jvdelisle@gcc.gnu.org>
+
+ PR fortran/33268
+ * gfortran.h: Add extra_comma pointer to gfc_dt structure. Add iokind to
+ gfc_expr value union. Add io_kind enum to here from io.c.
+ * io.c (gfc_free_dt): Free extra_comma.
+ (gfc_resolve_dt): If an extra comma was encountered and io_unit is type
+ BT_CHARACTER, resolve to format_expr and set default unit. Error if
+ io_kind is M_WRITE. (match_io): Match the extra comma and set new
+ pointer, extra_comma.
+
2008-05-01 Bud Davis <bdavis9659@sbcglobal.net>
PR35940/Fortran
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 168f078..f6a7c54 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -103,6 +103,12 @@ mstring;
/*************************** Enums *****************************/
+/* Used when matching and resolving data I/O transfer statements. */
+
+typedef enum
+{ M_READ, M_WRITE, M_PRINT, M_INQUIRE }
+io_kind;
+
/* The author remains confused to this day about the convention of
returning '0' for 'SUCCESS'... or was it the other way around? The
following enum makes things much more readable. We also start
@@ -1444,6 +1450,8 @@ typedef struct gfc_expr
{
int logical;
+ io_kind iokind;
+
mpz_t integer;
mpfr_t real;
@@ -1684,7 +1692,7 @@ typedef struct
{
gfc_expr *io_unit, *format_expr, *rec, *advance, *iostat, *size, *iomsg,
*id, *pos, *asynchronous, *blank, *decimal, *delim, *pad, *round,
- *sign;
+ *sign, *extra_comma;
gfc_symbol *namelist;
/* A format_label of `format_asterisk' indicates the "*" format */
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index 11907a7..4eb7630 100644
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -2143,11 +2143,6 @@ gfc_match_flush (void)
/******************** Data Transfer Statements *********************/
-typedef enum
-{ M_READ, M_WRITE, M_PRINT, M_INQUIRE }
-io_kind;
-
-
/* Return a default unit number. */
static gfc_expr *
@@ -2421,6 +2416,7 @@ gfc_free_dt (gfc_dt *dt)
gfc_free_expr (dt->round);
gfc_free_expr (dt->blank);
gfc_free_expr (dt->decimal);
+ gfc_free_expr (dt->extra_comma);
gfc_free (dt);
}
@@ -2451,9 +2447,40 @@ gfc_resolve_dt (gfc_dt *dt)
&& (e->ts.type != BT_INTEGER
&& (e->ts.type != BT_CHARACTER || e->expr_type != EXPR_VARIABLE)))
{
- gfc_error ("UNIT specification at %L must be an INTEGER expression "
- "or a CHARACTER variable", &e->where);
- return FAILURE;
+ /* If there is no extra comma signifying the "format" form of the IO
+ statement, then this must be an error. */
+ if (!dt->extra_comma)
+ {
+ gfc_error ("UNIT specification at %L must be an INTEGER expression "
+ "or a CHARACTER variable", &e->where);
+ return FAILURE;
+ }
+ else
+ {
+ /* At this point, we have an extra comma. If io_unit has arrived as
+ type chracter, we assume its really the "format" form of the I/O
+ statement. We set the io_unit to the default unit and format to
+ the chracter expression. See F95 Standard section 9.4. */
+ io_kind k;
+ k = dt->extra_comma->value.iokind;
+ if (e->ts.type == BT_CHARACTER && (k == M_READ || k == M_PRINT))
+ {
+ dt->format_expr = dt->io_unit;
+ dt->io_unit = default_unit (k);
+
+ /* Free this pointer now so that a warning/error is not triggered
+ below for the "Extension". */
+ gfc_free_expr (dt->extra_comma);
+ dt->extra_comma = NULL;
+ }
+
+ if (k == M_WRITE)
+ {
+ gfc_error ("Invalid form of WRITE statement at %L, UNIT required",
+ &dt->extra_comma->where);
+ return FAILURE;
+ }
+ }
}
if (e->ts.type == BT_CHARACTER)
@@ -2471,6 +2498,11 @@ gfc_resolve_dt (gfc_dt *dt)
return FAILURE;
}
+ if (dt->extra_comma
+ && gfc_notify_std (GFC_STD_GNU, "Extension: Comma before i/o "
+ "item list at %L", &dt->extra_comma->where) == FAILURE)
+ return FAILURE;
+
if (dt->err)
{
if (gfc_reference_st_label (dt->err, ST_LABEL_TARGET) == FAILURE)
@@ -3306,12 +3338,23 @@ get_io_list:
/* Used in check_io_constraints, where no locus is available. */
spec_end = gfc_current_locus;
- /* Optional leading comma (non-standard). */
- if (!comma_flag
- && gfc_match_char (',') == MATCH_YES
- && gfc_notify_std (GFC_STD_GNU, "Extension: Comma before i/o "
- "item list at %C") == FAILURE)
- return MATCH_ERROR;
+ /* Optional leading comma (non-standard). We use a gfc_expr structure here
+ to save the locus. This is used later when resolving transfer statements
+ that might have a format expression without unit number. */
+ if (!comma_flag && gfc_match_char (',') == MATCH_YES)
+ {
+ dt->extra_comma = gfc_get_expr ();
+
+ /* Set the types to something compatible with iokind. This is needed to
+ get through gfc_free_expr later since iokind really has no Basic Type,
+ BT, of its own. */
+ dt->extra_comma->expr_type = EXPR_CONSTANT;
+ dt->extra_comma->ts.type = BT_LOGICAL;
+
+ /* Save the iokind and locus for later use in resolution. */
+ dt->extra_comma->value.iokind = k;
+ dt->extra_comma->where = gfc_current_locus;
+ }
io_code = NULL;
if (gfc_match_eos () != MATCH_YES)