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, 85 insertions, 4 deletions

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 90f30b3..9f65fe4 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -2819,7 +2819,7 @@ match_attr_spec (void)
     DECL_IN, DECL_OUT, DECL_INOUT, DECL_INTRINSIC, DECL_OPTIONAL,
     DECL_PARAMETER, DECL_POINTER, DECL_PROTECTED, DECL_PRIVATE,
     DECL_PUBLIC, DECL_SAVE, DECL_TARGET, DECL_VALUE, DECL_VOLATILE,
-    DECL_IS_BIND_C, DECL_NONE,
+    DECL_IS_BIND_C, DECL_ASYNCHRONOUS, DECL_NONE,
     GFC_DECL_END /* Sentinel */
   }
   decl_types;
@@ -2864,9 +2864,25 @@ match_attr_spec (void)
 	  switch (gfc_peek_ascii_char ())
 	    {
 	    case 'a':
-	      if (match_string_p ("allocatable"))
-		d = DECL_ALLOCATABLE;
-	      break;
+	      gfc_next_ascii_char ();
+	      switch (gfc_next_ascii_char ())
+		{
+		case 'l':
+		  if (match_string_p ("locatable"))
+		    {
+		      /* Matched "allocatable".  */
+		      d = DECL_ALLOCATABLE;
+		    }
+		  break;
+
+		case 's':
+		  if (match_string_p ("ynchronous"))
+		    {
+		      /* Matched "asynchronous".  */
+		      d = DECL_ASYNCHRONOUS;
+		    }
+		  break;
+		}
 
 	    case 'b':
 	      /* Try and match the bind(c).  */
@@ -3047,6 +3063,9 @@ match_attr_spec (void)
 	  case DECL_ALLOCATABLE:
 	    attr = "ALLOCATABLE";
 	    break;
+	  case DECL_ASYNCHRONOUS:
+	    attr = "ASYNCHRONOUS";
+	    break;
 	  case DECL_DIMENSION:
 	    attr = "DIMENSION";
 	    break;
@@ -3173,6 +3192,15 @@ match_attr_spec (void)
 	  t = gfc_add_allocatable (&current_attr, &seen_at[d]);
 	  break;
 
+	case DECL_ASYNCHRONOUS:
+	  if (gfc_notify_std (GFC_STD_F2003,
+			      "Fortran 2003: ASYNCHRONOUS attribute at %C")
+	      == FAILURE)
+	    t = FAILURE;
+	  else
+	    t = gfc_add_asynchronous (&current_attr, NULL, &seen_at[d]);
+	  break;
+
 	case DECL_DIMENSION:
 	  t = gfc_add_dimension (&current_attr, NULL, &seen_at[d]);
 	  break;
@@ -6485,6 +6513,59 @@ syntax:
 }
 
 
+match
+gfc_match_asynchronous (void)
+{
+  gfc_symbol *sym;
+  match m;
+
+  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ASYNCHRONOUS statement at %C")
+      == FAILURE)
+    return MATCH_ERROR;
+
+  if (gfc_match (" ::") == MATCH_NO && gfc_match_space () == MATCH_NO)
+    {
+      return MATCH_ERROR;
+    }
+
+  if (gfc_match_eos () == MATCH_YES)
+    goto syntax;
+
+  for(;;)
+    {
+      /* ASYNCHRONOUS is special because it can be added to host-associated 
+	 symbols locally.  */
+      m = gfc_match_symbol (&sym, 1);
+      switch (m)
+	{
+	case MATCH_YES:
+	  if (gfc_add_asynchronous (&sym->attr, sym->name, &gfc_current_locus)
+	      == FAILURE)
+	    return MATCH_ERROR;
+	  goto next_item;
+
+	case MATCH_NO:
+	  break;
+
+	case MATCH_ERROR:
+	  return MATCH_ERROR;
+	}
+
+    next_item:
+      if (gfc_match_eos () == MATCH_YES)
+	break;
+      if (gfc_match_char (',') != MATCH_YES)
+	goto syntax;
+    }
+
+  return MATCH_YES;
+
+syntax:
+  gfc_error ("Syntax error in ASYNCHRONOUS statement at %C");
+  return MATCH_ERROR;
+}
+
+
 /* Match a module procedure statement.  Note that we have to modify
    symbols in the parent's namespace because the current one was there
    to receive symbols that are in an interface's formal argument list.  */