Commit a4792d44 by Thomas Koenig

gfortran.h (async_io_dt): Add external reference.

2017-10-07  Thomas Koenig  <tkoenig@gcc.gnu.org>

	* gfortran.h (async_io_dt): Add external reference.
	* io.c (async_io_dt): Add variable.
	(compare_to_allowed_values): Add prototyte. Add optional argument
	num. If present, set it to the number of the entry that was
	matched.
	(check_io_constraints): If this is for an asynchronous I/O
	statement, set async_io_dt and set the asynchronous flag for
	a SIZE tag.
	* resolve.c (resolve_transfer): If async_io_dt is set, set
	the asynchronous flag on the variable.
	(resolve_fl_namelist): If async_io_dt is set, set the asynchronous
	flag on all elements of the namelist.

From-SVN: r253508
parent e923330e
2017-10-07 Thomas Koenig <tkoenig@gcc.gnu.org>
* gfortran.h (async_io_dt): Add external reference.
* io.c (async_io_dt): Add variable.
(compare_to_allowed_values): Add prototyte. Add optional argument
num. If present, set it to the number of the entry that was
matched.
(check_io_constraints): If this is for an asynchronous I/O
statement, set async_io_dt and set the asynchronous flag for
a SIZE tag.
* resolve.c (resolve_transfer): If async_io_dt is set, set
the asynchronous flag on the variable.
(resolve_fl_namelist): If async_io_dt is set, set the asynchronous
flag on all elements of the namelist.
2017-10-04 Paul Thomas <pault@gcc.gnu.org> 2017-10-04 Paul Thomas <pault@gcc.gnu.org>
PR fortran/60458 PR fortran/60458
......
...@@ -3311,6 +3311,7 @@ void gfc_free_dt (gfc_dt *); ...@@ -3311,6 +3311,7 @@ void gfc_free_dt (gfc_dt *);
bool gfc_resolve_dt (gfc_dt *, locus *); bool gfc_resolve_dt (gfc_dt *, locus *);
void gfc_free_wait (gfc_wait *); void gfc_free_wait (gfc_wait *);
bool gfc_resolve_wait (gfc_wait *); bool gfc_resolve_wait (gfc_wait *);
extern bool async_io_dt;
/* module.c */ /* module.c */
void gfc_module_init_2 (void); void gfc_module_init_2 (void);
......
...@@ -111,6 +111,9 @@ static gfc_dt *current_dt; ...@@ -111,6 +111,9 @@ static gfc_dt *current_dt;
#define RESOLVE_TAG(x, y) if (!resolve_tag (x, y)) return false; #define RESOLVE_TAG(x, y) if (!resolve_tag (x, y)) return false;
/* Are we currently processing an asynchronous I/O statement? */
bool async_io_dt;
/**************** Fortran 95 FORMAT parser *****************/ /**************** Fortran 95 FORMAT parser *****************/
...@@ -1944,7 +1947,15 @@ static int ...@@ -1944,7 +1947,15 @@ static int
compare_to_allowed_values (const char *specifier, const char *allowed[], compare_to_allowed_values (const char *specifier, const char *allowed[],
const char *allowed_f2003[], const char *allowed_f2003[],
const char *allowed_gnu[], gfc_char_t *value, const char *allowed_gnu[], gfc_char_t *value,
const char *statement, bool warn) const char *statement, bool warn,
int *num = NULL);
static int
compare_to_allowed_values (const char *specifier, const char *allowed[],
const char *allowed_f2003[],
const char *allowed_gnu[], gfc_char_t *value,
const char *statement, bool warn, int *num)
{ {
int i; int i;
unsigned int len; unsigned int len;
...@@ -1961,7 +1972,11 @@ compare_to_allowed_values (const char *specifier, const char *allowed[], ...@@ -1961,7 +1972,11 @@ compare_to_allowed_values (const char *specifier, const char *allowed[],
for (i = 0; allowed[i]; i++) for (i = 0; allowed[i]; i++)
if (len == strlen (allowed[i]) if (len == strlen (allowed[i])
&& gfc_wide_strncasecmp (value, allowed[i], strlen (allowed[i])) == 0) && gfc_wide_strncasecmp (value, allowed[i], strlen (allowed[i])) == 0)
{
if (num)
*num = i;
return 1; return 1;
}
for (i = 0; allowed_f2003 && allowed_f2003[i]; i++) for (i = 0; allowed_f2003 && allowed_f2003[i]; i++)
if (len == strlen (allowed_f2003[i]) if (len == strlen (allowed_f2003[i])
...@@ -3611,7 +3626,8 @@ terminate_io (gfc_code *io_code) ...@@ -3611,7 +3626,8 @@ terminate_io (gfc_code *io_code)
/* Check the constraints for a data transfer statement. The majority of the /* Check the constraints for a data transfer statement. The majority of the
constraints appearing in 9.4 of the standard appear here. Some are handled constraints appearing in 9.4 of the standard appear here. Some are handled
in resolve_tag and others in gfc_resolve_dt. */ in resolve_tag and others in gfc_resolve_dt. Also set the async_io_dt flag
and, if necessary, the asynchronous flag on the SIZE argument. */
static match static match
check_io_constraints (io_kind k, gfc_dt *dt, gfc_code *io_code, check_io_constraints (io_kind k, gfc_dt *dt, gfc_code *io_code,
...@@ -3719,6 +3735,7 @@ if (condition) \ ...@@ -3719,6 +3735,7 @@ if (condition) \
if (dt->asynchronous) if (dt->asynchronous)
{ {
int num;
static const char * asynchronous[] = { "YES", "NO", NULL }; static const char * asynchronous[] = { "YES", "NO", NULL };
if (!gfc_reduce_init_expr (dt->asynchronous)) if (!gfc_reduce_init_expr (dt->asynchronous))
...@@ -3734,9 +3751,16 @@ if (condition) \ ...@@ -3734,9 +3751,16 @@ if (condition) \
if (!compare_to_allowed_values if (!compare_to_allowed_values
("ASYNCHRONOUS", asynchronous, NULL, NULL, ("ASYNCHRONOUS", asynchronous, NULL, NULL,
dt->asynchronous->value.character.string, dt->asynchronous->value.character.string,
io_kind_name (k), warn)) io_kind_name (k), warn, &num))
return MATCH_ERROR; return MATCH_ERROR;
/* Best to put this here because the yes/no info is still around. */
async_io_dt = num == 0;
if (async_io_dt && dt->size)
dt->size->symtree->n.sym->attr.asynchronous = 1;
} }
else
async_io_dt = false;
if (dt->id) if (dt->id)
{ {
......
...@@ -9196,6 +9196,9 @@ resolve_transfer (gfc_code *code) ...@@ -9196,6 +9196,9 @@ resolve_transfer (gfc_code *code)
"an assumed-size array", &code->loc); "an assumed-size array", &code->loc);
return; return;
} }
if (async_io_dt && exp->expr_type == EXPR_VARIABLE)
exp->symtree->n.sym->attr.asynchronous = 1;
} }
...@@ -14079,6 +14082,11 @@ resolve_fl_namelist (gfc_symbol *sym) ...@@ -14079,6 +14082,11 @@ resolve_fl_namelist (gfc_symbol *sym)
} }
} }
if (async_io_dt)
{
for (nl = sym->namelist; nl; nl = nl->next)
nl->sym->attr.asynchronous = 1;
}
return true; return true;
} }
......
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