re PR fortran/25829 ([F03] Asynchronous IO support)

2010-01-08  Tobias Burnus  <burnus@net-b.de

        PR/fortran 25829
        * symbol.c (check_conflict, gfc_copy_attr): Add
        ASYNCHRONOUS support.
        (gfc_add_asynchronous): New function.
        * decl.c (match_attr_spec): Add ASYNCHRONOUS support.
        (gfc_match_asynchronous): New function.
        * dump-parse-tree.c (show_attr): Add ASYNCHRONOUS support.
        * gfortran.h (symbol_attribute): New ASYNCHRONOUS bit.
        (gfc_add_asynchronous): New Prototype.
        * module.c (ab_attribute, mio_symbol_attribute): Add
        ASYNCHRONOUS support.
        * resolve.c (was_declared): Ditto.
        * match.h (gfc_match_asynchronous): New prototype.
        * parse.c (decode_specification_statement,decode_statement):
        Add ASYNCHRONOUS support.

2010-01-08  Tobias Burnus  <burnus@net-b.de

        PR/fortran 25829
        * gfortran.dg/asynchronous_1.f90: New test.
        * gfortran.dg/asynchronous_2.f90: New test.
        * gfortran.dg/conflicts.f90: Update error message.

From-SVN: r155732

1 files changed, 32 insertions, 1 deletions

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 8ba5adb..750aa2d 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -369,7 +369,8 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
     *use_assoc = "USE ASSOCIATED", *cray_pointer = "CRAY POINTER",
     *cray_pointee = "CRAY POINTEE", *data = "DATA", *value = "VALUE",
     *volatile_ = "VOLATILE", *is_protected = "PROTECTED",
-    *is_bind_c = "BIND(C)", *procedure = "PROCEDURE";
+    *is_bind_c = "BIND(C)", *procedure = "PROCEDURE",
+    *asynchronous = "ASYNCHRONOUS";
   static const char *threadprivate = "THREADPRIVATE";
 
   const char *a1, *a2;
@@ -559,6 +560,9 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
   conf (is_protected, external)
   conf (is_protected, in_common)
 
+  conf (asynchronous, intrinsic)
+  conf (asynchronous, external)
+
   conf (volatile_, intrinsic)
   conf (volatile_, external)
 
@@ -576,6 +580,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
   conf (procedure, target)
   conf (procedure, value)
   conf (procedure, volatile_)
+  conf (procedure, asynchronous)
   conf (procedure, entry)
 
   a1 = gfc_code2string (flavors, attr->flavor);
@@ -598,6 +603,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
       conf2 (dimension);
       conf2 (dummy);
       conf2 (volatile_);
+      conf2 (asynchronous);
       conf2 (pointer);
       conf2 (is_protected);
       conf2 (target);
@@ -640,8 +646,11 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
 
       if (attr->subroutine)
 	{
+	  a1 = subroutine;
 	  conf2 (target);
 	  conf2 (allocatable);
+	  conf2 (volatile_);
+	  conf2 (asynchronous);
 	  conf2 (in_namelist);
 	  conf2 (dimension);
 	  conf2 (function);
@@ -708,6 +717,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
       conf2 (in_common);
       conf2 (value);
       conf2 (volatile_);
+      conf2 (asynchronous);
       conf2 (threadprivate);
       conf2 (value);
       conf2 (is_bind_c);
@@ -1100,6 +1110,25 @@ gfc_add_volatile (symbol_attribute *attr, const char *name, locus *where)
 
 
 gfc_try
+gfc_add_asynchronous (symbol_attribute *attr, const char *name, locus *where)
+{
+  /* No check_used needed as 11.2.1 of the F2003 standard allows
+     that the local identifier made accessible by a use statement can be
+     given a ASYNCHRONOUS attribute.  */
+
+  if (attr->asynchronous && attr->asynchronous_ns == gfc_current_ns)
+    if (gfc_notify_std (GFC_STD_LEGACY, 
+        		"Duplicate ASYNCHRONOUS attribute specified at %L",
+			where) == FAILURE)
+      return FAILURE;
+
+  attr->asynchronous = 1;
+  attr->asynchronous_ns = gfc_current_ns;
+  return check_conflict (attr, name, where);
+}
+
+
+gfc_try
 gfc_add_threadprivate (symbol_attribute *attr, const char *name, locus *where)
 {
 
@@ -1659,6 +1688,8 @@ gfc_copy_attr (symbol_attribute *dest, symbol_attribute *src, locus *where)
     goto fail;
   if (src->volatile_ && gfc_add_volatile (dest, NULL, where) == FAILURE)
     goto fail;
+  if (src->asynchronous && gfc_add_asynchronous (dest, NULL, where) == FAILURE)
+    goto fail;
   if (src->threadprivate
       && gfc_add_threadprivate (dest, NULL, where) == FAILURE)
     goto fail;