re PR fortran/18918 (Eventually support Fortran 2008's coarrays [co-arrays])

2010-04-06  Tobias Burnus  <burnus@net-b.de>

        PR fortran/18918
        * array.c (gfc_free_array_spec,gfc_resolve_array_spec,
        match_array_element_spec,gfc_copy_array_spec,
        gfc_compare_array_spec): Include corank.
        (match_array_element_spec,gfc_set_array_spec): Support codimension.
        * decl.c (build_sym,build_struct,variable_decl,
        match_attr_spec,attr_decl1,cray_pointer_decl,
        gfc_match_volatile): Add codimension.
        (gfc_match_codimension): New function.
        * dump-parse-tree.c (show_array_spec,show_attr): Support
        * codimension.
        * gfortran.h (symbol_attribute,gfc_array_spec): Ditto.
        (gfc_add_codimension): New function prototype.
        * match.h (gfc_match_codimension): New function prototype.
        (gfc_match_array_spec): Update prototype
        * match.c (gfc_match_common): Update gfc_match_array_spec call.
        * module.c (MOD_VERSION): Bump.
        (mio_symbol_attribute): Support coarray attributes.
        (mio_array_spec): Add corank support.
        * parse.c (decode_specification_statement,decode_statement,
        parse_derived): Add coarray support.
        * resolve.c (resolve_formal_arglist, was_declared,
        is_non_constant_shape_array, resolve_fl_variable,
        resolve_fl_derived, resolve_symbol): Add coarray support.
        * symbol.c (check_conflict, gfc_add_volatile, gfc_copy_attr,
        gfc_build_class_symbol): Add coarray support.
        (gfc_add_codimension): New function.

2010-04-06  Tobias Burnus  <burnus@net-b.de>

        PR fortran/18918
        * gfortran.dg/coarray_4.f90: New test.
        * gfortran.dg/coarray_5.f90: New test.
        * gfortran.dg/coarray_6.f90: New test.

From-SVN: r158012

1 files changed, 75 insertions, 13 deletions

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 9237503..b376192 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1057,6 +1057,7 @@ build_sym (const char *name, gfc_charlen *cl,
      dimension attribute.  */
   attr = current_attr;
   attr.dimension = 0;
+  attr.codimension = 0;
 
   if (gfc_copy_attr (&sym->attr, &attr, var_locus) == FAILURE)
     return FAILURE;
@@ -1430,7 +1431,12 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init,
 
   c->as = *as;
   if (c->as != NULL)
-    c->attr.dimension = 1;
+    {
+      if (c->as->corank)
+	c->attr.codimension = 1;
+      if (c->as->rank)
+	c->attr.dimension = 1;
+    }
   *as = NULL;
 
   /* Should this ever get more complicated, combine with similar section
@@ -1589,7 +1595,7 @@ variable_decl (int elem)
   var_locus = gfc_current_locus;
 
   /* Now we could see the optional array spec. or character length.  */
-  m = gfc_match_array_spec (&as);
+  m = gfc_match_array_spec (&as, true, true);
   if (gfc_option.flag_cray_pointer && m == MATCH_YES)
     cp_as = gfc_copy_array_spec (as);
   else if (m == MATCH_ERROR)
@@ -2820,7 +2826,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_ASYNCHRONOUS, DECL_NONE,
+    DECL_IS_BIND_C, DECL_CODIMENSION, DECL_ASYNCHRONOUS, DECL_NONE,
     GFC_DECL_END /* Sentinel */
   }
   decl_types;
@@ -2894,6 +2900,11 @@ match_attr_spec (void)
 		goto cleanup;
 	      break;
 
+	    case 'c':
+	      if (match_string_p ("codimension"))
+		d = DECL_CODIMENSION;
+	      break;
+
 	    case 'd':
 	      if (match_string_p ("dimension"))
 		d = DECL_DIMENSION;
@@ -3041,7 +3052,7 @@ match_attr_spec (void)
 
       if (d == DECL_DIMENSION)
 	{
-	  m = gfc_match_array_spec (&current_as);
+	  m = gfc_match_array_spec (&current_as, true, false);
 
 	  if (m == MATCH_NO)
 	    {
@@ -3052,6 +3063,20 @@ match_attr_spec (void)
 	  if (m == MATCH_ERROR)
 	    goto cleanup;
 	}
+
+      if (d == DECL_CODIMENSION)
+	{
+	  m = gfc_match_array_spec (&current_as, false, true);
+
+	  if (m == MATCH_NO)
+	    {
+	      gfc_error ("Missing codimension specification at %C");
+	      m = MATCH_ERROR;
+	    }
+
+	  if (m == MATCH_ERROR)
+	    goto cleanup;
+	}
     }
 
   /* Since we've seen a double colon, we have to be looking at an
@@ -3067,6 +3092,9 @@ match_attr_spec (void)
 	  case DECL_ASYNCHRONOUS:
 	    attr = "ASYNCHRONOUS";
 	    break;
+	  case DECL_CODIMENSION:
+	    attr = "CODIMENSION";
+	    break;
 	  case DECL_DIMENSION:
 	    attr = "DIMENSION";
 	    break;
@@ -3135,9 +3163,9 @@ match_attr_spec (void)
 	continue;
 
       if (gfc_current_state () == COMP_DERIVED
-	  && d != DECL_DIMENSION && d != DECL_POINTER
-	  && d != DECL_PRIVATE   && d != DECL_PUBLIC
-	  && d != DECL_NONE)
+	  && d != DECL_DIMENSION && d != DECL_CODIMENSION
+	  && d != DECL_POINTER   && d != DECL_PRIVATE
+	  && d != DECL_PUBLIC && d != DECL_NONE)
 	{
 	  if (d == DECL_ALLOCATABLE)
 	    {
@@ -3202,6 +3230,10 @@ match_attr_spec (void)
 	    t = gfc_add_asynchronous (&current_attr, NULL, &seen_at[d]);
 	  break;
 
+	case DECL_CODIMENSION:
+	  t = gfc_add_codimension (&current_attr, NULL, &seen_at[d]);
+	  break;
+
 	case DECL_DIMENSION:
 	  t = gfc_add_dimension (&current_attr, NULL, &seen_at[d]);
 	  break;
@@ -5626,11 +5658,15 @@ attr_decl1 (void)
 
   /* Deal with possible array specification for certain attributes.  */
   if (current_attr.dimension
+      || current_attr.codimension
       || current_attr.allocatable
       || current_attr.pointer
       || current_attr.target)
     {
-      m = gfc_match_array_spec (&as);
+      m = gfc_match_array_spec (&as, !current_attr.codimension,
+				!current_attr.dimension
+				&& !current_attr.pointer
+				&& !current_attr.target);
       if (m == MATCH_ERROR)
 	goto cleanup;
 
@@ -5650,6 +5686,14 @@ attr_decl1 (void)
 	  goto cleanup;
 	}
 
+      if (current_attr.codimension && m == MATCH_NO)
+	{
+	  gfc_error ("Missing array specification at %L in CODIMENSION "
+		     "statement", &var_locus);
+	  m = MATCH_ERROR;
+	  goto cleanup;
+	}
+
       if ((current_attr.allocatable || current_attr.pointer)
 	  && (m == MATCH_YES) && (as->type != AS_DEFERRED))
 	{
@@ -5678,8 +5722,8 @@ attr_decl1 (void)
     }
   else
     {
-      if (current_attr.dimension == 0
-	    && gfc_copy_attr (&sym->attr, &current_attr, &var_locus) == FAILURE)
+      if (current_attr.dimension == 0 && current_attr.codimension == 0
+	  && gfc_copy_attr (&sym->attr, &current_attr, &var_locus) == FAILURE)
 	{
 	  m = MATCH_ERROR;
 	  goto cleanup;
@@ -5777,7 +5821,7 @@ static match
 cray_pointer_decl (void)
 {
   match m;
-  gfc_array_spec *as;
+  gfc_array_spec *as = NULL;
   gfc_symbol *cptr; /* Pointer symbol.  */
   gfc_symbol *cpte; /* Pointee symbol.  */
   locus var_locus;
@@ -5846,7 +5890,7 @@ cray_pointer_decl (void)
 	}
 
       /* Check for an optional array spec.  */
-      m = gfc_match_array_spec (&as);
+      m = gfc_match_array_spec (&as, true, false);
       if (m == MATCH_ERROR)
 	{
 	  gfc_free_array_spec (as);
@@ -6006,6 +6050,16 @@ gfc_match_allocatable (void)
 
 
 match
+gfc_match_codimension (void)
+{
+  gfc_clear_attr (&current_attr);
+  current_attr.codimension = 1;
+
+  return attr_decl ();
+}
+
+
+match
 gfc_match_dimension (void)
 {
   gfc_clear_attr (&current_attr);
@@ -6493,11 +6547,19 @@ gfc_match_volatile (void)
   for(;;)
     {
       /* VOLATILE is special because it can be added to host-associated 
-	 symbols locally.  */
+	 symbols locally. Except for coarrays. */
       m = gfc_match_symbol (&sym, 1);
       switch (m)
 	{
 	case MATCH_YES:
+	  /* F2008, C560+C561. VOLATILE for host-/use-associated variable or
+	     for variable in a BLOCK which is defined outside of the BLOCK.  */
+	  if (sym->ns != gfc_current_ns && sym->attr.codimension)
+	    {
+	      gfc_error ("Specifying VOLATILE for coarray variable '%s' at "
+			 "%C, which is use-/host-associated", sym->name);
+	      return MATCH_ERROR;
+	    }
 	  if (gfc_add_volatile (&sym->attr, sym->name, &gfc_current_locus)
 	      == FAILURE)
 	    return MATCH_ERROR;