From a4792d44311895bef287eb9632a1d4936ca8eafb Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Sat, 7 Oct 2017 11:43:58 +0000 Subject: [PATCH] gfortran.h (async_io_dt): Add external reference. 2017-10-07 Thomas Koenig * 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 --- gcc/fortran/ChangeLog | 15 +++++++++++++++ gcc/fortran/gfortran.h | 1 + gcc/fortran/io.c | 30 +++++++++++++++++++++++++++--- gcc/fortran/resolve.c | 8 ++++++++ 4 files changed, 51 insertions(+), 3 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index c38b34b944e..8d3e35f0e7d 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,18 @@ +2017-10-07 Thomas Koenig + + * 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 PR fortran/60458 diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 18a534d3c9d..b5fc1452747 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -3311,6 +3311,7 @@ void gfc_free_dt (gfc_dt *); bool gfc_resolve_dt (gfc_dt *, locus *); void gfc_free_wait (gfc_wait *); bool gfc_resolve_wait (gfc_wait *); +extern bool async_io_dt; /* module.c */ void gfc_module_init_2 (void); diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index af465dc00ea..463c00c2b29 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -111,6 +111,9 @@ static gfc_dt *current_dt; #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 *****************/ @@ -1944,7 +1947,15 @@ 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) + 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; unsigned int len; @@ -1961,7 +1972,11 @@ compare_to_allowed_values (const char *specifier, const char *allowed[], for (i = 0; allowed[i]; i++) if (len == strlen (allowed[i]) && gfc_wide_strncasecmp (value, allowed[i], strlen (allowed[i])) == 0) + { + if (num) + *num = i; return 1; + } for (i = 0; allowed_f2003 && allowed_f2003[i]; i++) if (len == strlen (allowed_f2003[i]) @@ -3611,7 +3626,8 @@ terminate_io (gfc_code *io_code) /* 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 - 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 check_io_constraints (io_kind k, gfc_dt *dt, gfc_code *io_code, @@ -3719,6 +3735,7 @@ if (condition) \ if (dt->asynchronous) { + int num; static const char * asynchronous[] = { "YES", "NO", NULL }; if (!gfc_reduce_init_expr (dt->asynchronous)) @@ -3734,9 +3751,16 @@ if (condition) \ if (!compare_to_allowed_values ("ASYNCHRONOUS", asynchronous, NULL, NULL, dt->asynchronous->value.character.string, - io_kind_name (k), warn)) + io_kind_name (k), warn, &num)) 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) { diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index e6f95d513d3..fab7c230c1a 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -9196,6 +9196,9 @@ resolve_transfer (gfc_code *code) "an assumed-size array", &code->loc); 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) } } + if (async_io_dt) + { + for (nl = sym->namelist; nl; nl = nl->next) + nl->sym->attr.asynchronous = 1; + } return true; } -- 2.30.2