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

2011-08-18  Tobias Burnus  <burnus@net-b.de>

        PR fortran/18918
        * parse.c (parse_derived): Add lock_type
        checks, improve coarray_comp handling.
        * resolve.c (resolve_allocate_expr,
        resolve_lock_unlock, resolve_symbol): Fix lock_type
        constraint checks.

2011-08-18  Tobias Burnus  <burnus@net-b.de>

        PR fortran/18918
        * gfortran.dg/coarray_lock_1.f90: Update dg-error.
        * gfortran.dg/coarray_lock_3.f90: Fix test.
        * gfortran.dg/coarray_lock_4.f90: New.
        * gfortran.dg/coarray_lock_5.f90: New.

From-SVN: r177867

1 files changed, 79 insertions, 9 deletions

diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 2910ab5..0aaad90 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -2018,7 +2018,7 @@ parse_derived (void)
   gfc_statement st;
   gfc_state_data s;
   gfc_symbol *sym;
-  gfc_component *c;
+  gfc_component *c, *lock_comp = NULL;
 
   accept_statement (ST_DERIVED_DECL);
   push_state (&s, COMP_DERIVED, gfc_new_block);
@@ -2126,19 +2126,28 @@ endType:
   sym = gfc_current_block ();
   for (c = sym->components; c; c = c->next)
     {
+      bool coarray, lock_type, allocatable, pointer;
+      coarray = lock_type = allocatable = pointer = false;
+
       /* Look for allocatable components.  */
       if (c->attr.allocatable
 	  || (c->ts.type == BT_CLASS && c->attr.class_ok
 	      && CLASS_DATA (c)->attr.allocatable)
 	  || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.alloc_comp))
-	sym->attr.alloc_comp = 1;
+	{
+	  allocatable = true;
+	  sym->attr.alloc_comp = 1;
+	}
 
       /* Look for pointer components.  */
       if (c->attr.pointer
 	  || (c->ts.type == BT_CLASS && c->attr.class_ok
 	      && CLASS_DATA (c)->attr.class_pointer)
 	  || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.pointer_comp))
-	sym->attr.pointer_comp = 1;
+	{
+	  pointer = true;
+	  sym->attr.pointer_comp = 1;
+	}
 
       /* Look for procedure pointer components.  */
       if (c->attr.proc_pointer
@@ -2148,15 +2157,76 @@ endType:
 
       /* Looking for coarray components.  */
       if (c->attr.codimension
-	  || (c->attr.coarray_comp && !c->attr.pointer && !c->attr.allocatable))
-	sym->attr.coarray_comp = 1;
+	  || (c->ts.type == BT_CLASS && c->attr.class_ok
+	      && CLASS_DATA (c)->attr.codimension))
+	{
+	  coarray = true;
+	  sym->attr.coarray_comp = 1;
+	}
+     
+      if (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.coarray_comp)
+	{
+	  coarray = true;
+	  if (!pointer && !allocatable)
+	    sym->attr.coarray_comp = 1;
+	}
 
       /* Looking for lock_type components.  */
-      if (c->attr.lock_comp
-	  || (sym->ts.type == BT_DERIVED
+      if ((c->ts.type == BT_DERIVED
 	      && c->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
-	      && c->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE))
-	sym->attr.lock_comp = 1;
+	      && c->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE)
+	  || (c->ts.type == BT_CLASS && c->attr.class_ok
+	      && CLASS_DATA (c)->ts.u.derived->from_intmod
+		 == INTMOD_ISO_FORTRAN_ENV
+	      && CLASS_DATA (c)->ts.u.derived->intmod_sym_id
+		 == ISOFORTRAN_LOCK_TYPE)
+	  || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.lock_comp
+	      && !allocatable && !pointer))
+	{
+	  lock_type = 1;
+	  lock_comp = c;
+	  sym->attr.lock_comp = 1;
+	}
+
+      /* Check for F2008, C1302 - and recall that pointers may not be coarrays
+	 (5.3.14) and that subobjects of coarray are coarray themselves (2.4.7),
+	 unless there are nondirect [allocatable or pointer] components
+	 involved (cf. 1.3.33.1 and 1.3.33.3).  */
+
+      if (pointer && !coarray && lock_type)
+	gfc_error ("Component %s at %L of type LOCK_TYPE must have a "
+		   "codimension or be a subcomponent of a coarray, "
+		   "which is not possible as the component has the "
+		   "pointer attribute", c->name, &c->loc);
+      else if (pointer && !coarray && c->ts.type == BT_DERIVED
+	       && c->ts.u.derived->attr.lock_comp)
+	gfc_error ("Pointer component %s at %L has a noncoarray subcomponent "
+		   "of type LOCK_TYPE, which must have a codimension or be a "
+		   "subcomponent of a coarray", c->name, &c->loc);
+
+      if (lock_type && allocatable && !coarray)
+	gfc_error ("Allocatable component %s at %L of type LOCK_TYPE must have "
+		   "a codimension", c->name, &c->loc);
+      else if (lock_type && allocatable && c->ts.type == BT_DERIVED
+	       && c->ts.u.derived->attr.lock_comp)
+	gfc_error ("Allocatable component %s at %L must have a codimension as "
+		   "it has a noncoarray subcomponent of type LOCK_TYPE",
+		   c->name, &c->loc);
+
+      if (sym->attr.coarray_comp && !coarray && lock_type)
+	gfc_error ("Noncoarray component %s at %L of type LOCK_TYPE or with "
+		   "subcomponent of type LOCK_TYPE must have a codimension or "
+		   "be a subcomponent of a coarray. (Variables of type %s may "
+		   "not have a codimension as already a coarray "
+		   "subcomponent exists)", c->name, &c->loc, sym->name);
+
+      if (sym->attr.lock_comp && coarray && !lock_type)
+	gfc_error ("Noncoarray component %s at %L of type LOCK_TYPE or with "
+		   "subcomponent of type LOCK_TYPE must have a codimension or "
+		   "be a subcomponent of a coarray. (Variables of type %s may "
+		   "not have a codimension as %s at %L has a codimension or a "
+		   "coarray subcomponent)", lock_comp->name, &lock_comp->loc,
+		   sym->name, c->name, &c->loc);
 
       /* Look for private components.  */
       if (sym->component_access == ACCESS_PRIVATE