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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c38b34b944e66993d19940f8c58a4465dd592b16..8d3e35f0e7d5785563b9cf311c878b98436654da 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,18 @@
+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>
 
        PR fortran/60458

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 18a534d3c9d6f6226e2082d23ab9ae4a00564267..b5fc1452747bcb3781de438e68c2d338d71e6f82 100644 (file)
--- 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 af465dc00ea7b469992f88da54f3a91d40717f99..463c00c2b2924fc90662690776ef672ca9cf7ddd 100644 (file)
--- 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 e6f95d513d34d00407ec0699533530f8c9df7dae..fab7c230c1a858d96f7817fe8014b9e76035a7b6 100644 (file)
--- 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;
 }