Commit ad7ee6f8 by Jerry DeLisle

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
parent 11835124
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> 2008-05-01 Bud Davis <bdavis9659@sbcglobal.net>
PR35940/Fortran PR35940/Fortran
......
...@@ -103,6 +103,12 @@ mstring; ...@@ -103,6 +103,12 @@ mstring;
/*************************** Enums *****************************/ /*************************** 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 /* The author remains confused to this day about the convention of
returning '0' for 'SUCCESS'... or was it the other way around? The returning '0' for 'SUCCESS'... or was it the other way around? The
following enum makes things much more readable. We also start following enum makes things much more readable. We also start
...@@ -1444,6 +1450,8 @@ typedef struct gfc_expr ...@@ -1444,6 +1450,8 @@ typedef struct gfc_expr
{ {
int logical; int logical;
io_kind iokind;
mpz_t integer; mpz_t integer;
mpfr_t real; mpfr_t real;
...@@ -1684,7 +1692,7 @@ typedef struct ...@@ -1684,7 +1692,7 @@ typedef struct
{ {
gfc_expr *io_unit, *format_expr, *rec, *advance, *iostat, *size, *iomsg, gfc_expr *io_unit, *format_expr, *rec, *advance, *iostat, *size, *iomsg,
*id, *pos, *asynchronous, *blank, *decimal, *delim, *pad, *round, *id, *pos, *asynchronous, *blank, *decimal, *delim, *pad, *round,
*sign; *sign, *extra_comma;
gfc_symbol *namelist; gfc_symbol *namelist;
/* A format_label of `format_asterisk' indicates the "*" format */ /* A format_label of `format_asterisk' indicates the "*" format */
......
...@@ -2143,11 +2143,6 @@ gfc_match_flush (void) ...@@ -2143,11 +2143,6 @@ gfc_match_flush (void)
/******************** Data Transfer Statements *********************/ /******************** Data Transfer Statements *********************/
typedef enum
{ M_READ, M_WRITE, M_PRINT, M_INQUIRE }
io_kind;
/* Return a default unit number. */ /* Return a default unit number. */
static gfc_expr * static gfc_expr *
...@@ -2421,6 +2416,7 @@ gfc_free_dt (gfc_dt *dt) ...@@ -2421,6 +2416,7 @@ gfc_free_dt (gfc_dt *dt)
gfc_free_expr (dt->round); gfc_free_expr (dt->round);
gfc_free_expr (dt->blank); gfc_free_expr (dt->blank);
gfc_free_expr (dt->decimal); gfc_free_expr (dt->decimal);
gfc_free_expr (dt->extra_comma);
gfc_free (dt); gfc_free (dt);
} }
...@@ -2451,9 +2447,40 @@ gfc_resolve_dt (gfc_dt *dt) ...@@ -2451,9 +2447,40 @@ gfc_resolve_dt (gfc_dt *dt)
&& (e->ts.type != BT_INTEGER && (e->ts.type != BT_INTEGER
&& (e->ts.type != BT_CHARACTER || e->expr_type != EXPR_VARIABLE))) && (e->ts.type != BT_CHARACTER || e->expr_type != EXPR_VARIABLE)))
{ {
gfc_error ("UNIT specification at %L must be an INTEGER expression " /* If there is no extra comma signifying the "format" form of the IO
"or a CHARACTER variable", &e->where); statement, then this must be an error. */
return FAILURE; 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) if (e->ts.type == BT_CHARACTER)
...@@ -2471,6 +2498,11 @@ gfc_resolve_dt (gfc_dt *dt) ...@@ -2471,6 +2498,11 @@ gfc_resolve_dt (gfc_dt *dt)
return FAILURE; 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 (dt->err)
{ {
if (gfc_reference_st_label (dt->err, ST_LABEL_TARGET) == FAILURE) if (gfc_reference_st_label (dt->err, ST_LABEL_TARGET) == FAILURE)
...@@ -3306,12 +3338,23 @@ get_io_list: ...@@ -3306,12 +3338,23 @@ get_io_list:
/* Used in check_io_constraints, where no locus is available. */ /* Used in check_io_constraints, where no locus is available. */
spec_end = gfc_current_locus; spec_end = gfc_current_locus;
/* Optional leading comma (non-standard). */ /* Optional leading comma (non-standard). We use a gfc_expr structure here
if (!comma_flag to save the locus. This is used later when resolving transfer statements
&& gfc_match_char (',') == MATCH_YES that might have a format expression without unit number. */
&& gfc_notify_std (GFC_STD_GNU, "Extension: Comma before i/o " if (!comma_flag && gfc_match_char (',') == MATCH_YES)
"item list at %C") == FAILURE) {
return MATCH_ERROR; 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; io_code = NULL;
if (gfc_match_eos () != MATCH_YES) if (gfc_match_eos () != MATCH_YES)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment