[patch, fortran] Set implicit ASYNCHRONOUS attribute

[Thomas Koenig <tkoenig@netcologne.de>]

[-- Attachment #1: Type: text/plain, Size: 1645 bytes --]

Hello world,

the attached patch sets the implicit ASYNCHRONPUS according to F2008,
9.6.2.5:

# If a variable is used in an asynchronous data transfer statement as
# • an item in an input/output list,
# • a group object in a namelist, or
# • a SIZE= specifier
# the base object of the data-ref is implicitly given the ASYNCHRONOUS 
attribute in the scoping unit of the
# data transfer statement. This attribute may be confirmed by explicit 
declaration.

At the moment, the only thing this does is show up on the fortran tree
dump. This will hopefully change once asynchronous I/O is implemented.
And if you are wondering why I put setting the global variable into
check_io_constraints: It is because the parsing of the YES/NO
is done there, and I didn't want to duplicate the code.

No test case because we don't (yet) have tests for -fdump-fortran-original.

Regression-tested.  OK for trunk?

Regards

	Thomas

2017-10-04  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.

[-- Attachment #2: p1.diff --]
[-- Type: text/x-patch, Size: 3032 bytes --]

Index: gfortran.h
===================================================================
--- gfortran.h	(Revision 253377)
+++ gfortran.h	(Arbeitskopie)
@@ -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);
Index: io.c
===================================================================
--- io.c	(Revision 253381)
+++ io.c	(Arbeitskopie)
@@ -111,7 +111,10 @@ 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  *****************/
 
 /* FORMAT tokens returned by format_lex().  */
@@ -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,
   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])
@@ -3719,6 +3734,7 @@ if (condition) \
 
   if (dt->asynchronous) 
     {
+      int num;
       static const char * asynchronous[] = { "YES", "NO", NULL };
 
       if (!gfc_reduce_init_expr (dt->asynchronous))
@@ -3734,9 +3750,15 @@ 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;
+
+      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)
     {
Index: resolve.c
===================================================================
--- resolve.c	(Revision 253377)
+++ resolve.c	(Arbeitskopie)
@@ -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;
 }