diff options
author | Jerry DeLisle <jvdelisle@gcc.gnu.org> | 2008-05-03 15:11:33 +0000 |
---|---|---|
committer | Jerry DeLisle <jvdelisle@gcc.gnu.org> | 2008-05-03 15:11:33 +0000 |
commit | ad7ee6f8d5a0fda91de731835f909a3c330db24d (patch) | |
tree | 3a2e67ce85966590b4fb8f93a08d35134b0a8ba0 /gcc/fortran | |
parent | 1183512494cf8f3ca0b5460808d563ec0f8f14ec (diff) | |
download | gcc-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/ChangeLog | 11 | ||||
-rw-r--r-- | gcc/fortran/gfortran.h | 10 | ||||
-rw-r--r-- | gcc/fortran/io.c | 71 |
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) |