[Patch, Fortran] (Coarray) Fix constraint checks for LOCK_TYPE

[Patch, Fortran] (Coarray) Fix constraint checks for LOCK_TYPE

[Tobias Burnus]

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

This patch fixes two issues:

a) LOCK(coarray%lock_type_comp) is also a coarray.

b) The following constraint was incompletely checked for: C1302. For 
reference, I also list C1303/C1304.

C1302 A named variable of type LOCK TYPE shall be a coarray. A named 
variable with a noncoarray subcomponent of type LOCK TYPE shall be a 
coarray.

C1303 A lock variable shall not appear in a variable definition context 
except as the lock-variable in a LOCK or UNLOCK statement, as an 
allocate-object, or as an actual argument in a reference to a procedure 
with an explicit interface where the corresponding dummy argument has 
INTENT (INOUT).

C1304 A variable with a subobject of type LOCK TYPE shall not appear in 
a variable definition context except as an allocate-object or as an 
actual argument in a reference to a procedure with an explicit interface 
where the corresponding dummy argument has INTENT (INOUT).

Build and regtested on x86-64-linux.
OK for the trunk.

Tobias

PS: It somehow took me quite some time to understand "subcomponent" even 
though the standard is rather clear about it. For reference:

"1.3.33.3 subcomponent -- <structure> direct component that is a 
subobject of the structure (6.4.2)

"1.3.33.1 direct component -- one of the components, or one of the 
direct components of a nonpointer nonallocatable component (4.5.1)"

[-- Attachment #2: lock-check.diff --]
[-- Type: text/x-patch, Size: 11371 bytes --]

2011-08-02  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-02  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.
	* gfortran.dg/coarray_lock_6.f90: New.

diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index ba28648..6fca032 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -2010,7 +2010,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);
@@ -2118,19 +2118,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
@@ -2140,15 +2149,62 @@ 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.codimension)
+	{
+	  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))
+	{
+	  if (pointer)
+	    gfc_error ("Pointer component %s at %L of LOCK_TYPE must be a "
+		       "coarray", c->name, &c->loc);
+	  lock_type = 1;
+	  lock_comp = c;
+	  sym->attr.lock_comp = 1;
+	}
+
+      if (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;
+	}
+
+      /* F2008, C1302.  */
+
+      if (lock_type && allocatable && !coarray)
+	gfc_error ("Component %s at %L of LOCK_TYPE or with LOCK_TYPE "
+		   "component is allocatable but not a coarray",
+		   c->name, &c->loc);
+
+      if (sym->attr.coarray_comp && !coarray && lock_type)
+	gfc_error ("Component %s at %L of LOCK_TYPE or with LOCK_TYPE is not a "
+		   "coarray, but other coarray components exist", c->name,
+		   &c->loc);
+
+      if (sym->attr.lock_comp && coarray && !lock_type)
+	gfc_error ("Component %s at %L of LOCK_TYPE or with LOCK_TYPE has to "
+		   "be a coarray as %s at %L has a codimension",
+		   lock_comp->name, &lock_comp->loc, c->name, &c->loc);	
 
       /* Look for private components.  */
       if (sym->component_access == ACCESS_PRIVATE
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index b4d66cc..fcd6583 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -6806,7 +6806,7 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code)
 
       /* Check F2008, C642.  */
       if (code->expr3->ts.type == BT_DERIVED
-	  && ((codimension &&  gfc_expr_attr (code->expr3).lock_comp)
+	  && ((codimension && gfc_expr_attr (code->expr3).lock_comp)
 	      || (code->expr3->ts.u.derived->from_intmod
 		     == INTMOD_ISO_FORTRAN_ENV
 		  && code->expr3->ts.u.derived->intmod_sym_id
@@ -8224,10 +8224,9 @@ resolve_lock_unlock (gfc_code *code)
       || code->expr1->ts.u.derived->from_intmod != INTMOD_ISO_FORTRAN_ENV
       || code->expr1->ts.u.derived->intmod_sym_id != ISOFORTRAN_LOCK_TYPE
       || code->expr1->rank != 0
-      || !(gfc_expr_attr (code->expr1).codimension
-	   || gfc_is_coindexed (code->expr1)))
-    gfc_error ("Lock variable at %L must be a scalar coarray of type "
-	       "LOCK_TYPE", &code->expr1->where);
+      || (!gfc_is_coarray (code->expr1) && !gfc_is_coindexed (code->expr1)))
+    gfc_error ("Lock variable at %L must be a scalar of type LOCK_TYPE",
+	       &code->expr1->where);
 
   /* Check STAT.  */
   if (code->expr2
@@ -12403,12 +12402,13 @@ resolve_symbol (gfc_symbol *sym)
 
   /* F2008, C1302.  */
   if (sym->ts.type == BT_DERIVED
-      && sym->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
-      && sym->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE
-      && !sym->attr.codimension)
+      && ((sym->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
+	   && sym->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE)
+	  || sym->ts.u.derived->attr.lock_comp)
+      && !sym->attr.codimension && !sym->ts.u.derived->attr.coarray_comp)
     {
-      gfc_error ("Variable '%s' at %L of type LOCK_TYPE must be a coarray",
-		 sym->name, &sym->declared_at);
+      gfc_error ("Variable %s at %L of LOCK_TYPE or with LOCK_TYPE component "
+		 "must be a coarray", sym->name, &sym->declared_at);
       return;
     }
 
diff --git a/gcc/testsuite/gfortran.dg/coarray_lock_1.f90 b/gcc/testsuite/gfortran.dg/coarray_lock_1.f90
index f9ef581..419ba47 100644
--- a/gcc/testsuite/gfortran.dg/coarray_lock_1.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_lock_1.f90
@@ -10,6 +10,6 @@ integer :: s
 character(len=3) :: c
 logical :: bool
 
-LOCK (a, stat=s, acquired_lock=bool, errmsg=c) ! { dg-error "must be a scalar coarray of type LOCK_TYPE" }
-UNLOCK (a, stat=s, errmsg=c) ! { dg-error "must be a scalar coarray of type LOCK_TYPE" }
+LOCK (a, stat=s, acquired_lock=bool, errmsg=c) ! { dg-error "must be a scalar of type LOCK_TYPE" }
+UNLOCK (a, stat=s, errmsg=c) ! { dg-error "must be a scalar of type LOCK_TYPE" }
 end
diff --git a/gcc/testsuite/gfortran.dg/coarray_lock_3.f90 b/gcc/testsuite/gfortran.dg/coarray_lock_3.f90
index b23d87e..2456311 100644
--- a/gcc/testsuite/gfortran.dg/coarray_lock_3.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_lock_3.f90
@@ -19,11 +19,21 @@ module m
   type t
     type(lock_type), allocatable :: x(:)[:]
   end type t
+end module m
 
+module m2
+  use iso_fortran_env
   type t2
-    type(lock_type), allocatable :: x
+    type(lock_type), allocatable :: x ! { dg-error "of LOCK_TYPE or with LOCK_TYPE component is allocatable but not a coarray" }
   end type t2
-end module m
+end module m2
+
+module m3
+  use iso_fortran_env
+  type t3
+    type(lock_type) :: x ! OK
+  end type t3
+end module m3
 
 subroutine sub(x)
   use iso_fortran_env
@@ -46,15 +56,15 @@ subroutine sub3(x) ! { dg-error "with coarray component shall be a nonpointer, n
 end subroutine sub3
 
 subroutine sub4(x)
-  use m
-  type(t2), intent(inout) :: x[*] ! OK
+  use m3
+  type(t3), intent(inout) :: x[*] ! OK
 end subroutine sub4
 
 subroutine lock_test
   use iso_fortran_env
   type t
   end type t
-  type(lock_type) :: lock ! { dg-error "type LOCK_TYPE must be a coarray" }
+  type(lock_type) :: lock ! { dg-error "of LOCK_TYPE or with LOCK_TYPE component must be a coarray" }
 end subroutine lock_test
 
 subroutine lock_test2
@@ -65,10 +75,10 @@ subroutine lock_test2
   type(t) :: x
   type(lock_type), save :: lock[*],lock2(2)[*]
   lock(t) ! { dg-error "Syntax error in LOCK statement" }
-  lock(x) ! { dg-error "must be a scalar coarray of type LOCK_TYPE" }
+  lock(x) ! { dg-error "must be a scalar of type LOCK_TYPE" }
   lock(lock)
   lock(lock2(1))
-  lock(lock2) ! { dg-error "must be a scalar coarray of type LOCK_TYPE" }
+  lock(lock2) ! { dg-error "must be a scalar of type LOCK_TYPE" }
   lock(lock[1]) ! OK
 end subroutine lock_test2
 
@@ -104,4 +114,4 @@ contains
   end subroutine test
 end subroutine argument_check
 
-! { dg-final { cleanup-modules "m" } }
+! { dg-final { cleanup-modules "m m2 m3" } }
--- /dev/null	2011-08-02 08:54:55.563886097 +0200
+++ gcc/gcc/testsuite/gfortran.dg/coarray_lock_4.f90	2011-07-28 17:15:20.000000000 +0200
@@ -0,0 +1,64 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+!
+!
+! LOCK/LOCK_TYPE checks 
+!
+
+subroutine valid()
+  use iso_fortran_env
+  implicit none
+  type t
+    type(lock_type) :: lock
+  end type t
+
+  type t2
+    type(lock_type), allocatable :: lock(:)[:]
+  end type t2
+
+  type(t), save :: a[*]
+  type(t2), save :: b ! OK
+
+  allocate(b%lock(1)[*])
+  LOCK(a%lock) ! OK
+  LOCK(a[1]%lock) ! OK
+
+  LOCK(b%lock(1)) ! OK
+  LOCK(b%lock(1)[1]) ! OK
+end subroutine valid
+
+subroutine invalid()
+  use iso_fortran_env
+  implicit none
+  type t
+    type(lock_type) :: lock
+  end type t
+  type(t), save :: a ! { dg-error "LOCK_TYPE or with LOCK_TYPE component must be a coarray" }
+end subroutine invalid
+
+subroutine more_tests
+  use iso_fortran_env
+  implicit none
+  type t
+    type(lock_type) :: a ! OK
+  end type t
+
+  type t1
+    type(lock_type), allocatable :: c2(:)[:] ! OK 
+  end type t1
+  type(t1) :: x1 ! OK
+
+  type t2
+    type(lock_type), allocatable :: c1(:) ! { dg-error "of LOCK_TYPE or with LOCK_TYPE component is allocatable but not a coarray" }
+  end type t2
+
+  type t3
+    type(t) :: b
+  end type t3
+  type(t3) :: x3 ! { dg-error "of LOCK_TYPE or with LOCK_TYPE component must be a coarray" }
+
+  type t4
+    type(lock_type) :: c0(2)
+  end type t4
+  type(t4) :: x4 ! { dg-error "LOCK_TYPE or with LOCK_TYPE component must be a coarray" }
+end subroutine more_tests
--- /dev/null	2011-08-02 08:54:55.563886097 +0200
+++ gcc/gcc/testsuite/gfortran.dg/coarray_lock_5.f90	2011-07-29 01:00:14.000000000 +0200
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+!
+!
+! LOCK/LOCK_TYPE checks 
+!
+
--- /dev/null	2011-08-02 08:54:55.563886097 +0200
+++ gcc/gcc/testsuite/gfortran.dg/coarray_lock_6.f90	2011-08-02 14:12:24.000000000 +0200
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+!
+module m3
+  use iso_fortran_env
+  type, extends(lock_type) :: lock
+    integer :: j = 7
+  end type lock
+end module m3
+
+use m3
+type(lock_type) :: tl[*] = lock_type ()
+type(lock) :: t[*]
+tl = lock_type () ! { dg-error "variable definition context" }
+print *,t%j
+end
+
+! { dg-final { cleanup-modules "m3" } }

Re: [Patch, Fortran] (Coarray) Fix constraint checks for LOCK_TYPE

[Mikael Morin]

Hello,

On Tuesday 02 August 2011 18:08:05 Tobias Burnus wrote:
> This patch fixes two issues:
> 
> a) LOCK(coarray%lock_type_comp) is also a coarray.
> 
> b) The following constraint was incompletely checked for: C1302. For
> reference, I also list C1303/C1304.

[...]

> 
> PS: It somehow took me quite some time to understand "subcomponent" even
> though the standard is rather clear about it. 
Is it? It seems I haven't understood the constraint as you did.
And by the way, are there cases of direct components that are not 
subcomponents? I find it hard to distinguish them.

> For reference:
> 
> "1.3.33.3 subcomponent -- <structure> direct component that is a
> subobject of the structure (6.4.2)
> 
> "1.3.33.1 direct component -- one of the components, or one of the
> direct components of a nonpointer nonallocatable component (4.5.1)"
> 
and:
> C1302 A named variable of type LOCK TYPE shall be a coarray. A named
> variable with a noncoarray subcomponent of type LOCK TYPE shall be a
> coarray.
> 
So basically, one looks at the components of a structure, and the components 
of all the non-allocatable non-pointer derived type components (and so on 
recursively...).
Among those components, if one has type LOCK_TYPE and is not a coarray, then 
the enclosing variable shall be a coarray (which seems to mean that all 
variables of this type have to be a coarray).
Though variables in the general case can be components, I don't think it is 
the case here as only named variables are involved here.
Does that sound right?
Then, ...

> lock-check.diff
>   2011-08-02  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-02  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.
>         * gfortran.dg/coarray_lock_6.f90: New.
> 
> diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
> index ba28648..6fca032 100644
> --- a/gcc/fortran/parse.c
> +++ b/gcc/fortran/parse.c
> @@ -2010,7 +2010,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);
> @@ -2118,19 +2118,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
> @@ -2140,15 +2149,62 @@ 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.codimension)
> +       {
> +         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))
> +       {
> +         if (pointer)
> +           gfc_error ("Pointer component %s at %L of LOCK_TYPE must be a "
> +                      "coarray", c->name, &c->loc);
... this is wrong as the constraint should be on the variable, not on the 
components of its type.

> +         lock_type = 1;
> +         lock_comp = c;
> +         sym->attr.lock_comp = 1;
> +       }
> +
> +      if (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;
> +       }
> +
> +      /* F2008, C1302.  */
> +
> +      if (lock_type && allocatable && !coarray)
> +       gfc_error ("Component %s at %L of LOCK_TYPE or with LOCK_TYPE "
> +                  "component is allocatable but not a coarray",
> +                  c->name, &c->loc);
> +
> +      if (sym->attr.coarray_comp && !coarray && lock_type)
> +       gfc_error ("Component %s at %L of LOCK_TYPE or with LOCK_TYPE is not 
a "
> +                  "coarray, but other coarray components exist", c->name,
> +                  &c->loc);
> +
> +      if (sym->attr.lock_comp && coarray && !lock_type)
> +       gfc_error ("Component %s at %L of LOCK_TYPE or with LOCK_TYPE has to 
"
> +                  "be a coarray as %s at %L has a codimension",
> +                  lock_comp->name, &lock_comp->loc, c->name, &c->loc); 
Same here (the three of them) the constraint is not on components.

About the wording, I think it should be `[...] of type LOCK_TYPE or with a 
subcomponent of type LOCK_TYPE...', that is drop neither the "a subcomponent" 
after "with" nor the "type" before "LOCK_TYPE" (even if the latter sounds 
odd).
Maybe it can be (slightly) simplified to `[...] of type or with a subcomponent 
of type LOCK_TYPE...'?


Random comments on the rest of the patch below:
>  
>        /* Look for private components.  */
>        if (sym->component_access == ACCESS_PRIVATE
> diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
> index b4d66cc..fcd6583 100644
> --- a/gcc/fortran/resolve.c
> +++ b/gcc/fortran/resolve.c
> @@ -6806,7 +6806,7 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code)
>  
>        /* Check F2008, C642.  */
>        if (code->expr3->ts.type == BT_DERIVED
> -         && ((codimension &&  gfc_expr_attr (code->expr3).lock_comp)
> +         && ((codimension && gfc_expr_attr (code->expr3).lock_comp)
>               || (code->expr3->ts.u.derived->from_intmod
>                      == INTMOD_ISO_FORTRAN_ENV
>                   && code->expr3->ts.u.derived->intmod_sym_id
> @@ -8224,10 +8224,9 @@ resolve_lock_unlock (gfc_code *code)
>        || code->expr1->ts.u.derived->from_intmod != INTMOD_ISO_FORTRAN_ENV
>        || code->expr1->ts.u.derived->intmod_sym_id != ISOFORTRAN_LOCK_TYPE
>        || code->expr1->rank != 0
> -      || !(gfc_expr_attr (code->expr1).codimension
> -          || gfc_is_coindexed (code->expr1)))
> -    gfc_error ("Lock variable at %L must be a scalar coarray of type "
> -              "LOCK_TYPE", &code->expr1->where);
> +      || (!gfc_is_coarray (code->expr1) && !gfc_is_coindexed (code-
>expr1)))
> +    gfc_error ("Lock variable at %L must be a scalar of type LOCK_TYPE",
> +              &code->expr1->where);
>  
>    /* Check STAT.  */
>    if (code->expr2
This part is quite OK.
I have the feeling that !gfc_is_coindexed is superfluous once one has 
!gfc_is_coarray.
I'm also not sure that the removal of `coarray' in the error message is 
needed as C1302 forces LOCK_TYPE entities to be coarrays or subobjects of 
coarrays.


> @@ -12403,12 +12402,13 @@ resolve_symbol (gfc_symbol *sym)
>  
>    /* F2008, C1302.  */
>    if (sym->ts.type == BT_DERIVED
> -      && sym->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
> -      && sym->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE
> -      && !sym->attr.codimension)
> +      && ((sym->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
> +          && sym->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE)
> +         || sym->ts.u.derived->attr.lock_comp)
> +      && !sym->attr.codimension && !sym->ts.u.derived->attr.coarray_comp)
>      {
> -      gfc_error ("Variable '%s' at %L of type LOCK_TYPE must be a coarray",
> -                sym->name, &sym->declared_at);
> +      gfc_error ("Variable %s at %L of LOCK_TYPE or with LOCK_TYPE 
component "
> +                "must be a coarray", sym->name, &sym->declared_at);
>        return;
>      }
>  
Looks like it's not sufficient.
One can have a non-coarray LOCK_TYPE component and an other component that is 
a coarray.
Then the error won't trigger as attr.coarray_comp is set by the other 
component.


[...]
> --- /dev/null   2011-08-02 08:54:55.563886097 +0200
> +++ gcc/gcc/testsuite/gfortran.dg/coarray_lock_5.f90    2011-07-29 
01:00:14.000000000 +0200
> @@ -0,0 +1,7 @@
> +! { dg-do compile }
> +! { dg-options "-fcoarray=single" }
> +!
> +!
> +! LOCK/LOCK_TYPE checks 
> +!
> +

This one was passing already, wasn't it? ;-)


Mikael

Re: [Patch, Fortran] (Coarray) Fix constraint checks for LOCK_TYPE

[Tobias Burnus]

Mikael,

first, thanks for carefully reading the patch!

On 08/03/2011 01:43 PM, Mikael Morin wrote:
> > PS: It somehow took me quite some time to understand "subcomponent" even
> > though the standard is rather clear about it. 
> Is it? It seems I haven't understood the constraint as you did.

It's like the famous saying: "Unix is user friendly, it is just picky
about its friends."

Regarding this part of the standard, I only feel acquainted but not
being a real friend ... I think it is clearly stated in the standard,
but I continue to struggle to apply it correctly.

> So basically, one looks at the components of a structure, and the components 
> of all the non-allocatable non-pointer derived type components (and so on 
> recursively...).

That's also my reading.

> Among those components, if one has type LOCK_TYPE and is not a coarray, then the enclosing variable shall be a coarray (which seems to mean that all 
> variables of this type have to be a coarray).

Yes, I think that's what the constraint requires at the end: In
LOCK(expr) the "expr" needs to be a coarray - or coindexed (such that it
were a coarray without the coindex).

> Though variables in the general case can be components, I don't think it is 
> the case here as only named variables are involved here.
> Does that sound right?

The first part of the sentence sounds wrong: A component itself is not a
variable. I think you mean a "structure-component" - and for "var%comp"
both "var%comp" and "var" are variables and I belief both "var%comp" and
"var" are named.

"R602 variable is designator or expr"
"R601 designator is object-name or ... or structure-component"
"R613 structure-component is data-ref"
"R611 data-ref is part-ref [ % part-ref ]"
"R612 part-ref is part-name [ ( section-subscript-list ) ] [
image-selector ]"


> >        /* 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))
> > +       {
> > +         if (pointer)
> > +           gfc_error ("Pointer component %s at %L of LOCK_TYPE must be a "
> > +                      "coarray", c->name, &c->loc);
> ... this is wrong as the constraint should be on the variable, not on the 
> components of its type.

I think you are right: The derived-type declaration itself is valid
according to the standard - one just may not use it for variable
declaration.

The question is: Should we bother? Is there some genuine interest in
supporting valid but unusable type declarations? The problem is that
diagnosing the problem can get rather difficult. For instance:

type t
type(lock_type) :: C
end type
type t2
type(t), allocatable :: B
end type t2
type t3
type(t2) :: D
end type t3

is valid - however, it is invalid to use:
type(t) :: x[*], y

However, how to write then the error message? "Error: Invalid
declaration at (1) as constraint C642 is violated" is probably not very
helpful, but should one really re-resolve the derived type? There are
also many possible solutions:

"B" should be a coarray, "C" could be also allocatable and a coarray, or
"B" could be not allocatable and "D" or "y" could be a coarray.

Thus, writing a nice and helpful message gets pretty complicated. And,
as written, I do not see a compelling reason for not diagnosing it at
type-declaration time - even if the type is formally correct.


Regarding the check itself - if one assumes that one wants to have an
error, I believe that part is correct. If there is a pointer, it cannot
be valid. Example 1:

type t
type(lock_type), pointer :: lock1
end type t

I cannot write "lock1[:]" as in components, only allocatables are allowed:

"C442 (R436) If a coarray-spec appears, it shall be a
deferred-coshape-spec-list and the component shall have the ALLOCATABLE
attribute."

Turning the variable into a coarray as in
type(t) :: x[*]
does not help: the x%lock1 is not a coarray. "A subobject of a coarray
is a coarray if it does not have any cosubscripts, vector subscripts,
allocatable component selection, or pointer component selection." (Sect.
2.4.7)

On the other hand, if "type t" contains a noncoarray lock_type, one
cannot do use "type(t), pointer :: ptrcomp" as "...%ptrcomp%lock"
wouldn't be a coarray (cf. above) - and if "lock" in "...%ptrcomp%lock"
were a coarray, it would be invalid as: "C444 A data component whose
type has a coarray ultimate component shall be a nonpointer
nonallocatable scalar and shall not be a coarray."


Having said that, I just realized that the following program is not
rejected but it should:

use iso_fortran_env
type t
type(lock_type) :: lock
end type t

type t2
type(t), pointer :: x
end type t2
end


The modified section of the patch would then be:

/* Looking for lock_type components. */
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)
|| (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;
}

/* F2008, C1302. */

if (pointer && !coarray && (lock_type
|| (c->ts.type == BT_DERIVED
&& c->ts.u.derived->attr.lock_comp)))
gfc_error ("Component %s at %L of LOCK_TYPE or with LOCK_TYPE "
"component is a pointer but not a coarray",
c->name, &c->loc);

[...]
> > +      if (sym->attr.lock_comp && coarray && !lock_type)
> > +       gfc_error ("Component %s at %L of LOCK_TYPE or with LOCK_TYPE has to "
>> > +                  "be a coarray as %s at %L has a codimension",
>> > +                  lock_comp->name, &lock_comp->loc, c->name, &c->loc); 
> Same here (the three of them) the constraint is not on components.

Here, something similar applies:

type t
integer, allocatable :: caf_comp[:]
type(lock_type) :: lock
end type t
type(t) :: x[*]

It is invalid to make "x" a coarray as "t" already has coarray
components - but if I don't make "x" a coarray, x%lock is not a coarray,
which is invalid.

Thus, I believe there is no way that this error is printed for a type
declaration which can be used to create a valid named variable.

>> > +      || (!gfc_is_coarray (code->expr1) && !gfc_is_coindexed (code-
>> >expr1)))
> This part is quite OK.
> I have the feeling that !gfc_is_coindexed is superfluous once one has 
> !gfc_is_coarray.
> I'm also not sure that the removal of `coarray' in the error message is 
> needed as C1302 forces LOCK_TYPE entities to be coarrays or subobjects of 
> coarrays.

The LOCK_TYPE named object needs to be a coarray - the entity you pass
to LOCK does not have to be a coarray. Example:

type(lock_type), type :: lock[*]
LOCK(lock) ! (1)
LOCK(lock[1]) ! (2)

In (1), the argument is a scalar coarray of lock_type. But in (2) one
does not have a coarray but just a coindexed scalar of lock_type.

As "lock[1]" is not a coarray, I believe removing "coarray" from the
error message makes sense as does checking for both gfc_is_coarray and
gfc_is_coindexed.

> Looks like it's not sufficient.
> One can have a non-coarray LOCK_TYPE component and an other component that is 
> a coarray.

That's the reason for all the checks in parse.c. I make use of the fact
that one cannot have more than one coarray - if a component is a
coarray, the variable cannot be a coarray and vice versa. I think I have
covered all cases there, but I might be wrong (as I already have been
for the pointer, cf. above).

> > @@ -0,0 +1,7 @@
> > +! { dg-do compile }
> > +! { dg-options "-fcoarray=single" }
> > +!
> > +!
> > +! LOCK/LOCK_TYPE checks 
> > +!
> > +
> This one was passing already, wasn't it? ;-)

Hopefully!

Tobias

Re: [Patch, Fortran] (Coarray) Fix constraint checks for LOCK_TYPE

[Tobias Burnus]

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

Tobias Burnus wrote:
> Mikael, first, thanks for carefully reading the patch!

Updated patch attached. Changes:
- parse.c: Cleaned up a bit, use suggested wording, add missing 
diagnostic (cf. my previous mail)
- resolve.c: use suggested wording
- coarray_lock_5.f90: Remove.
- coarray_lock_6.f90: Move to coarray_lock_5.f90, add additional test 
case for the newly found issue.

Build and regtested on x86-64-linux.
OK for the trunk?

Tobias

[-- Attachment #2: lock-check-v2.diff --]
[-- Type: text/x-patch, Size: 11638 bytes --]

2011-08-04  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-04  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.

diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 2910ab5..9f732e5 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,61 @@ 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.codimension)
+	{
+	  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;
+	}
+
+      /* F2008, C1302.  */
+
+      if (pointer && !coarray && (lock_type
+				  || (c->ts.type == BT_DERIVED
+				      && c->ts.u.derived->attr.lock_comp)))
+	gfc_error ("Component %s at %L of type LOCK_TYPE or with subcomponent "
+		   "of type LOCK_TYPE is a pointer but not a coarray",
+		   c->name, &c->loc);
+
+      if (lock_type && allocatable && !coarray)
+	gfc_error ("Component %s at %L of type LOCK_TYPE or with subcomponent "
+		   "of type LOCK_TYPE is allocatable but not a "
+		   "coarray", c->name, &c->loc);
+
+      if (sym->attr.coarray_comp && !coarray && lock_type)
+	gfc_error ("Component %s at %L of type LOCK_TYPE or with subcomponent "
+		   "of type LOCK_TYPE is not a coarray, but other coarray "
+		   "components exist", c->name, &c->loc);
+
+      if (sym->attr.lock_comp && coarray && !lock_type)
+	gfc_error ("Component %s at %L of type LOCK_TYPE or with subcomponent "
+		   "of type LOCK_TYPE has to be a coarray as %s at %L has a "
+		   "codimension", lock_comp->name, &lock_comp->loc, c->name,
+		   &c->loc);
 
       /* Look for private components.  */
       if (sym->component_access == ACCESS_PRIVATE
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index b8a8ebb..f801750 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -6806,7 +6806,7 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code)
 
       /* Check F2008, C642.  */
       if (code->expr3->ts.type == BT_DERIVED
-	  && ((codimension &&  gfc_expr_attr (code->expr3).lock_comp)
+	  && ((codimension && gfc_expr_attr (code->expr3).lock_comp)
 	      || (code->expr3->ts.u.derived->from_intmod
 		     == INTMOD_ISO_FORTRAN_ENV
 		  && code->expr3->ts.u.derived->intmod_sym_id
@@ -8224,10 +8224,9 @@ resolve_lock_unlock (gfc_code *code)
       || code->expr1->ts.u.derived->from_intmod != INTMOD_ISO_FORTRAN_ENV
       || code->expr1->ts.u.derived->intmod_sym_id != ISOFORTRAN_LOCK_TYPE
       || code->expr1->rank != 0
-      || !(gfc_expr_attr (code->expr1).codimension
-	   || gfc_is_coindexed (code->expr1)))
-    gfc_error ("Lock variable at %L must be a scalar coarray of type "
-	       "LOCK_TYPE", &code->expr1->where);
+      || (!gfc_is_coarray (code->expr1) && !gfc_is_coindexed (code->expr1)))
+    gfc_error ("Lock variable at %L must be a scalar of type LOCK_TYPE",
+	       &code->expr1->where);
 
   /* Check STAT.  */
   if (code->expr2
@@ -12405,12 +12404,14 @@ resolve_symbol (gfc_symbol *sym)
 
   /* F2008, C1302.  */
   if (sym->ts.type == BT_DERIVED
-      && sym->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
-      && sym->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE
-      && !sym->attr.codimension)
+      && ((sym->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
+	   && sym->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE)
+	  || sym->ts.u.derived->attr.lock_comp)
+      && !sym->attr.codimension && !sym->ts.u.derived->attr.coarray_comp)
     {
-      gfc_error ("Variable '%s' at %L of type LOCK_TYPE must be a coarray",
-		 sym->name, &sym->declared_at);
+      gfc_error ("Variable %s at %L of type LOCK_TYPE or with subcomponent of "
+		 "type LOCK_TYPE must be a coarray", sym->name,
+		 &sym->declared_at);
       return;
     }
 
diff --git a/gcc/testsuite/gfortran.dg/coarray_lock_1.f90 b/gcc/testsuite/gfortran.dg/coarray_lock_1.f90
index f9ef581..419ba47 100644
--- a/gcc/testsuite/gfortran.dg/coarray_lock_1.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_lock_1.f90
@@ -10,6 +10,6 @@ integer :: s
 character(len=3) :: c
 logical :: bool
 
-LOCK (a, stat=s, acquired_lock=bool, errmsg=c) ! { dg-error "must be a scalar coarray of type LOCK_TYPE" }
-UNLOCK (a, stat=s, errmsg=c) ! { dg-error "must be a scalar coarray of type LOCK_TYPE" }
+LOCK (a, stat=s, acquired_lock=bool, errmsg=c) ! { dg-error "must be a scalar of type LOCK_TYPE" }
+UNLOCK (a, stat=s, errmsg=c) ! { dg-error "must be a scalar of type LOCK_TYPE" }
 end
diff --git a/gcc/testsuite/gfortran.dg/coarray_lock_3.f90 b/gcc/testsuite/gfortran.dg/coarray_lock_3.f90
index b23d87e..60db32b 100644
--- a/gcc/testsuite/gfortran.dg/coarray_lock_3.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_lock_3.f90
@@ -19,11 +19,21 @@ module m
   type t
     type(lock_type), allocatable :: x(:)[:]
   end type t
+end module m
 
+module m2
+  use iso_fortran_env
   type t2
-    type(lock_type), allocatable :: x
+    type(lock_type), allocatable :: x ! { dg-error "of type LOCK_TYPE or with subcomponent of type LOCK_TYPE is allocatable but not a coarray" }
   end type t2
-end module m
+end module m2
+
+module m3
+  use iso_fortran_env
+  type t3
+    type(lock_type) :: x ! OK
+  end type t3
+end module m3
 
 subroutine sub(x)
   use iso_fortran_env
@@ -46,15 +56,15 @@ subroutine sub3(x) ! { dg-error "with coarray component shall be a nonpointer, n
 end subroutine sub3
 
 subroutine sub4(x)
-  use m
-  type(t2), intent(inout) :: x[*] ! OK
+  use m3
+  type(t3), intent(inout) :: x[*] ! OK
 end subroutine sub4
 
 subroutine lock_test
   use iso_fortran_env
   type t
   end type t
-  type(lock_type) :: lock ! { dg-error "type LOCK_TYPE must be a coarray" }
+  type(lock_type) :: lock ! { dg-error "of type LOCK_TYPE or with subcomponent of type LOCK_TYPE must be a coarray" }
 end subroutine lock_test
 
 subroutine lock_test2
@@ -65,10 +75,10 @@ subroutine lock_test2
   type(t) :: x
   type(lock_type), save :: lock[*],lock2(2)[*]
   lock(t) ! { dg-error "Syntax error in LOCK statement" }
-  lock(x) ! { dg-error "must be a scalar coarray of type LOCK_TYPE" }
+  lock(x) ! { dg-error "must be a scalar of type LOCK_TYPE" }
   lock(lock)
   lock(lock2(1))
-  lock(lock2) ! { dg-error "must be a scalar coarray of type LOCK_TYPE" }
+  lock(lock2) ! { dg-error "must be a scalar of type LOCK_TYPE" }
   lock(lock[1]) ! OK
 end subroutine lock_test2
 
@@ -104,4 +114,4 @@ contains
   end subroutine test
 end subroutine argument_check
 
-! { dg-final { cleanup-modules "m" } }
+! { dg-final { cleanup-modules "m m2 m3" } }
--- /dev/null	2011-08-03 07:40:52.435887713 +0200
+++ gcc/gcc/testsuite/gfortran.dg/coarray_lock_4.f90	2011-08-03 23:24:30.000000000 +0200
@@ -0,0 +1,64 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+!
+!
+! LOCK/LOCK_TYPE checks 
+!
+
+subroutine valid()
+  use iso_fortran_env
+  implicit none
+  type t
+    type(lock_type) :: lock
+  end type t
+
+  type t2
+    type(lock_type), allocatable :: lock(:)[:]
+  end type t2
+
+  type(t), save :: a[*]
+  type(t2), save :: b ! OK
+
+  allocate(b%lock(1)[*])
+  LOCK(a%lock) ! OK
+  LOCK(a[1]%lock) ! OK
+
+  LOCK(b%lock(1)) ! OK
+  LOCK(b%lock(1)[1]) ! OK
+end subroutine valid
+
+subroutine invalid()
+  use iso_fortran_env
+  implicit none
+  type t
+    type(lock_type) :: lock
+  end type t
+  type(t), save :: a ! { dg-error "type LOCK_TYPE or with subcomponent of type LOCK_TYPE must be a coarray" }
+end subroutine invalid
+
+subroutine more_tests
+  use iso_fortran_env
+  implicit none
+  type t
+    type(lock_type) :: a ! OK
+  end type t
+
+  type t1
+    type(lock_type), allocatable :: c2(:)[:] ! OK 
+  end type t1
+  type(t1) :: x1 ! OK
+
+  type t2
+    type(lock_type), allocatable :: c1(:) ! { dg-error "of type LOCK_TYPE or with subcomponent of type LOCK_TYPE is allocatable but not a coarray" }
+  end type t2
+
+  type t3
+    type(t) :: b
+  end type t3
+  type(t3) :: x3 ! { dg-error "of type LOCK_TYPE or with subcomponent of type LOCK_TYPE must be a coarray" }
+
+  type t4
+    type(lock_type) :: c0(2)
+  end type t4
+  type(t4) :: x4 ! { dg-error "of type LOCK_TYPE or with subcomponent of type LOCK_TYPE must be a coarray" }
+end subroutine more_tests
--- /dev/null	2011-08-03 07:40:52.435887713 +0200
+++ gcc/gcc/testsuite/gfortran.dg/coarray_lock_5.f90	2011-08-03 23:21:59.000000000 +0200
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+!
+! LOCK_TYPE checks
+!
+module m3
+  use iso_fortran_env
+  type, extends(lock_type) :: lock
+    integer :: j = 7
+  end type lock
+end module m3
+
+use m3
+type(lock_type) :: tl[*] = lock_type ()
+type(lock) :: t[*]
+tl = lock_type () ! { dg-error "variable definition context" }
+print *,t%j
+end
+
+subroutine test()
+  use iso_fortran_env
+  type t
+    type(lock_type) :: lock
+  end type t
+
+  type t2
+    type(t), pointer :: x ! { dg-error "of type LOCK_TYPE or with subcomponent of type LOCK_TYPE" }
+  end type t2
+end subroutine test
+
+! { dg-final { cleanup-modules "m3" } }

Re: [Patch, Fortran] (Coarray) Fix constraint checks for LOCK_TYPE

[Mikael Morin]

On Wednesday 03 August 2011 17:55:00 Tobias Burnus wrote:
> > Though variables in the general case can be components, I don't think it
> > is the case here as only named variables are involved here.
> > Does that sound right?
> 
> The first part of the sentence sounds wrong: A component itself is not a
> variable. I think you mean a "structure-component" - and for "var%comp"
> both "var%comp" and "var" are variables
Yes, OK

> and I belief both "var%comp" and
> "var" are named.
My reading is that a named variable is a variable that is an object-name.
But either is fine w.r.t. your patch.

> 
> "R602 variable is designator or expr"
> "R601 designator is object-name or ... or structure-component"
> "R613 structure-component is data-ref"
> "R611 data-ref is part-ref [ % part-ref ]"
> "R612 part-ref is part-name [ ( section-subscript-list ) ] [
> image-selector ]"
> 

[...]
> 
> The question is: Should we bother? Is there some genuine interest in
> supporting valid but unusable type declarations? 
OK, I'm starting to understand the patch.

> The problem is that
> diagnosing the problem can get rather difficult. For instance:
> 
> type t
> type(lock_type) :: C
> end type
> type t2
> type(t), allocatable :: B
> end type t2
> type t3
> type(t2) :: D
> end type t3
> 
> is valid - however, it is invalid to use:
> type(t) :: x[*], y
> 
> However, how to write then the error message? "Error: Invalid
> declaration at (1) as constraint C642 is violated" is probably not very
> helpful, but should one really re-resolve the derived type?
I would write:
Variable at <y> shall be a coarray/have a codimension attribute as it has a 
non-coarray subcomponent of type LOCK_TYPE at <c>

Best would be to have the full reference y%d%b%c in the error message. 

> There are
> also many possible solutions:
> 
> "B" should be a coarray, "C" could be also allocatable and a coarray, or
> "B" could be not allocatable and "D" or "y" could be a coarray.
> 
> Thus, writing a nice and helpful message gets pretty complicated.
Thus, we should stick closely to the standard, point exactly what is 
prohibited, and not bother too much trying to provide some hints to the users. 
;-)

> And, as written, I do not see a compelling reason for not diagnosing it at
> type-declaration time - even if the type is formally correct.
Well, OK, but we should precise exactly why we reject it then.

> 
> 
> Regarding the check itself - if one assumes that one wants to have an
> error, I believe that part is correct. If there is a pointer, it cannot
> be valid. Example 1:
> 
> type t
> type(lock_type), pointer :: lock1
> end type t
> 
> I cannot write "lock1[:]" as in components, only allocatables are allowed:
> 
> "C442 (R436) If a coarray-spec appears, it shall be a
> deferred-coshape-spec-list and the component shall have the ALLOCATABLE
> attribute."
> 
> Turning the variable into a coarray as in
> type(t) :: x[*]
> does not help: the x%lock1 is not a coarray. "A subobject of a coarray
> is a coarray if it does not have any cosubscripts, vector subscripts,
> allocatable component selection, or pointer component selection." (Sect.
> 2.4.7)
> 
> On the other hand, if "type t" contains a noncoarray lock_type, one
> cannot do use "type(t), pointer :: ptrcomp" as "...%ptrcomp%lock"
> wouldn't be a coarray (cf. above) - and if "lock" in "...%ptrcomp%lock"
> were a coarray, it would be invalid as: "C444 A data component whose
> type has a coarray ultimate component shall be a nonpointer
> nonallocatable scalar and shall not be a coarray."
OK, it is starting to make sense now.
I'm not very fond of it, but if you want to keep this diagnostic, at the very 
least put all that information in a comment. Best would be to provide it (or 
some of it) in the error message too.

Currently there is a comment indicating that we check C1302. Fine.
One looks at C1302: OK, if a component is like that, that constraint on the 
variable. Fine. The error's on variables, and there is neither allocatable nor 
pointer crazy stuff.
One looks at the code then:
if (pointer)
  error ("Component blah pointer blah")

if (allocatable)
  error ("Component blah allocatable blah")

What the fuck?
Back to the standard then, is it a typo?
Check C3102, C1320, C1032. Nothing...
Err?

So, please make it explicit why you reject pointer, etc...

> 
> 
> Having said that, I just realized that the following program is not
> rejected but it should:
That's exactly the reason why I don't like it.
It's sufficiently difficult to get it right while sticking closely to the 
standard that one doesn't want to try picking one rule every 40 pages and see 
what is left after intersecting them.

[...]
> Here, something similar applies:
> 
> type t
> integer, allocatable :: caf_comp[:]
> type(lock_type) :: lock
> end type t
> type(t) :: x[*]
> 
> It is invalid to make "x" a coarray as "t" already has coarray
> components - but if I don't make "x" a coarray, x%lock is not a coarray,
> which is invalid.
Again, make it explicit in the code/in the error message.

> 
> Thus, I believe there is no way that this error is printed for a type
> declaration which can be used to create a valid named variable.
> 
> >> > +      || (!gfc_is_coarray (code->expr1) && !gfc_is_coindexed (code-
> >> >
> >> >expr1)))
> > 
> > This part is quite OK.
> > I have the feeling that !gfc_is_coindexed is superfluous once one has
> > !gfc_is_coarray.
> > I'm also not sure that the removal of `coarray' in the error message is
> > needed as C1302 forces LOCK_TYPE entities to be coarrays or subobjects of
> > coarrays.
> 
> The LOCK_TYPE named object needs to be a coarray - the entity you pass
> to LOCK does not have to be a coarray. Example:
> 
> type(lock_type), type :: lock[*]
> LOCK(lock) ! (1)
> LOCK(lock[1]) ! (2)
> 
> In (1), the argument is a scalar coarray of lock_type. But in (2) one
> does not have a coarray but just a coindexed scalar of lock_type.
OK.

> 
> As "lock[1]" is not a coarray, I believe removing "coarray" from the
> error message makes sense as does checking for both gfc_is_coarray and
> gfc_is_coindexed.
OK.

> 
> > Looks like it's not sufficient.
> > One can have a non-coarray LOCK_TYPE component and an other component
> > that is a coarray.
> 
> That's the reason for all the checks in parse.c. I make use of the fact
> that one cannot have more than one coarray - if a component is a
> coarray, the variable cannot be a coarray and vice versa. I think I have
> covered all cases there, but I might be wrong (as I already have been
> for the pointer, cf. above).
I'll review the revised patch later today. With the information you have 
provided it should be better accepted. :-)

Mikael

Re: [Patch, Fortran] (Coarray) Fix constraint checks for LOCK_TYPE

[Tobias Burnus]

On 08/04/2011 02:44 PM, Mikael Morin wrote:
>> and I belief both "var%comp" and
>> "var" are named.
> My reading is that a named variable is a variable that is an object-name.

That's actually my problem with the standard - it never quite tells what 
a "named variable" exactly is. I think at least "ptrfunction()" is not a 
named variable but just a variable.

>> The problem is that
>> diagnosing the problem can get rather difficult. For instance:
>>
>> type t
>> type(lock_type) :: C
>> end type
>> type t2
>> type(t), allocatable :: B
>> end type t2
>> type t3
>> type(t2) :: D
>> end type t3
>>
>> is valid - however, it is invalid to use:
>> type(t) :: x[*], y
>>
>> However, how to write then the error message? "Error: Invalid
>> declaration at (1) as constraint C642 is violated" is probably not very
>> helpful, but should one really re-resolve the derived type?
> I would write:
> Variable at<y>  shall be a coarray/have a codimension attribute as it has a
> non-coarray subcomponent of type LOCK_TYPE at<c>

But that error message would be very surprising for me as a user if I 
had written:

   type(t) :: x[*]

because "x" *is* a coarray - only "x%D%B" is not a coarray, which were 
fine if B weren't an allocatable/pointer or if B%C were not of LOCK_TYPE 
or B%C were itself a coarray.

> Best would be to have the full reference y%d%b%c in the error message.

I think that works not well in the current scheme as one would have to 
store this information somewhere. Either, one resolves from the outside 
to the inside: Resolve "x", which resolves "x%D", which resolves 
"x%D%B"  - and when resolving "B" the "x%D%" part is not available. Or 
one stores that "B" is invalid, then one propagates this information on 
to "D" and then to "x" - at that point one knows that "x" is invalid - 
but the information that it is due to "x%D%B" is lost.

Additionally, for the example above, should it be "x%D%B" or x%D%B%C or ...?

That's not unsolvable but requires quite some restructuring.

> Thus, we should stick closely to the standard, point exactly what is
> prohibited, and not bother too much trying to provide some hints to the users.
> ;-)

Exactly: "ERROR: C642"

Would be the most correct error message, without bothering with the 
error location, variable name - and it also contains the 42. Or even 
better "ERROR: Violating Fortran 2008 standard" ;-)

If we want to really stick close to the standard, I would propose to add 
an attr.lock_c642_violated to the derived types and check for it later 
in resolve_symbol :P.

> OK, it is starting to make sense now.
> I'm not very fond of it, but if you want to keep this diagnostic, at the very
> least put all that information in a comment. Best would be to provide it (or
> some of it) in the error message too.

I made three attempts to get the LOCK_TYPE diagnostics kind of right. I 
can also do a fourth attempt, if it is cleaner or for some other reason 
better. However, I only do it if I get a clear outline how it should be 
done, i.e. which information is stored where, where it is obtained and 
how the error message should roughly look like.

The problem with the wording is that the constraint itself is not 
directly checkable but that one has to do it in a slightly convoluted 
way. Actually, the standard does the same: Certain things are prohibited 
as one bumps into other constraints if one tries to sneak past the 
constraint.

I do not mind having something better, but coming up with some concise 
but still correct - and helpful! - comment is not that simple.

>> Having said that, I just realized that the following program is not
>> rejected but it should:
> That's exactly the reason why I don't like it. It's sufficiently difficult to get it right while sticking closely to the standard that one doesn't want to try picking one rule every 40 pages and see what is left after intersecting them.

Sorry, I cannot follow. The standard does not have constraint C123456789 
saying that it is invalid. The invalidity comes the combination of 
several constrains and definitions. That makes it difficult to spot all 
the cases which are (in)valid, but I do not see how one can prevent it. 
Thus, I claim I am "sticking closely to the standard" by rejecting the 
invalid code.

I agree that the wording could be better - but it is also difficult to 
write it in such a way that it helps a user when debugging a code as 
there might be different reason for the mistake.

Furthermore, I have stared too long at the code to be apt to find good 
wordings, thus, I am happy for suggestions for better comments and error 
messages.

> I'll review the revised patch later today.

Thanks.

Tobias

Re: [Patch, Fortran] (Coarray) Fix constraint checks for LOCK_TYPE

[Mikael Morin]

On Thursday 04 August 2011 15:18:46 Tobias Burnus wrote:
> >> The problem is that
> >> diagnosing the problem can get rather difficult. For instance:
> >> 
> >> type t
> >> type(lock_type) :: C
> >> end type
> >> type t2
> >> type(t), allocatable :: B
> >> end type t2
> >> type t3
> >> type(t2) :: D
> >> end type t3
> >> 
> >> is valid - however, it is invalid to use:
> >> type(t) :: x[*], y
> >> 
> >> However, how to write then the error message? "Error: Invalid
> >> declaration at (1) as constraint C642 is violated" is probably not very
> >> helpful, but should one really re-resolve the derived type?
> > 
> > I would write:
> > Variable at<y>  shall be a coarray/have a codimension attribute as it has
> > a non-coarray subcomponent of type LOCK_TYPE at<c>
> 
> But that error message would be very surprising for me as a user if I
> had written:
> 
>    type(t) :: x[*]
In that case you wouldn't have this error, but you could still have some other 
errors coming from other rules. 


> > Best would be to have the full reference y%d%b%c in the error message.
> 
> I think that works not well in the current scheme as one would have to
> store this information somewhere. Either, one resolves from the outside
> to the inside: Resolve "x", which resolves "x%D", which resolves
> "x%D%B"  - and when resolving "B" the "x%D%" part is not available. Or
> one stores that "B" is invalid, then one propagates this information on
> to "D" and then to "x" - at that point one knows that "x" is invalid -
> but the information that it is due to "x%D%B" is lost.
> 
> Additionally, for the example above, should it be "x%D%B" or x%D%B%C or
> ...?
> 
> That's not unsolvable but requires quite some restructuring.
Yes, it was just a thought.

> 
> > Thus, we should stick closely to the standard, point exactly what is
> > prohibited, and not bother too much trying to provide some hints to the
> > users. ;-)
> 
> Exactly: "ERROR: C642"
> 
> Would be the most correct error message, without bothering with the
> error location, variable name - and it also contains the 42. Or even
> better "ERROR: Violating Fortran 2008 standard" ;-)
> 
> If we want to really stick close to the standard, I would propose to add
> an attr.lock_c642_violated to the derived types and check for it later
> in resolve_symbol :P.
> 
> > OK, it is starting to make sense now.
> > I'm not very fond of it, but if you want to keep this diagnostic, at the
> > very least put all that information in a comment. Best would be to
> > provide it (or some of it) in the error message too.
> 
> I made three attempts to get the LOCK_TYPE diagnostics kind of right. I
> can also do a fourth attempt, if it is cleaner or for some other reason
> better. However, I only do it if I get a clear outline how it should be
> done, i.e. which information is stored where, where it is obtained and
> how the error message should roughly look like.
> 
> The problem with the wording is that the constraint itself is not
> directly checkable but that one has to do it in a slightly convoluted
> way. Actually, the standard does the same: Certain things are prohibited
> as one bumps into other constraints if one tries to sneak past the
> constraint.
My point is we should let the user bump himself into other constraints and 
figure out what is right. 

> 
> I do not mind having something better, but coming up with some concise
> but still correct - and helpful! - comment is not that simple.
> 
> >> Having said that, I just realized that the following program is not
> > 
> >> rejected but it should:
> > That's exactly the reason why I don't like it. It's sufficiently
> > difficult to get it right while sticking closely to the standard that
> > one doesn't want to try picking one rule every 40 pages and see what is
> > left after intersecting them.
> 
> Sorry, I cannot follow. The standard does not have constraint C123456789
> saying that it is invalid. The invalidity comes the combination of
> several constrains and definitions. 
My point is we should diagnose the constraints, not the combination of them...

> That makes it difficult to spot all the cases which are (in)valid,
...for exactly this reason.

> but I do not see how one can prevent it.
> Thus, I claim I am "sticking closely to the standard" by rejecting the
> invalid code.
> 
> I agree that the wording could be better - but it is also difficult to
> write it in such a way that it helps a user when debugging a code as
> there might be different reason for the mistake.
> 
> Furthermore, I have stared too long at the code to be apt to find good
> wordings, thus, I am happy for suggestions for better comments and error
> messages.
I'll propose some.

Mikael

Re: [Patch, Fortran] (Coarray) Fix constraint checks for LOCK_TYPE

[Steve Kargl]

On Thu, Aug 04, 2011 at 03:18:46PM +0200, Tobias Burnus wrote:
> On 08/04/2011 02:44 PM, Mikael Morin wrote:
> >>and I belief both "var%comp" and
> >>"var" are named.
> >My reading is that a named variable is a variable that is an object-name.
> 
> That's actually my problem with the standard - it never quite tells what 
> a "named variable" exactly is. I think at least "ptrfunction()" is not a 
> named variable but just a variable.
> 

F2003, page 432:

  named:  Having a name.  That is, in a phrase such as "named variable,"
  the word "named" signifies that the variable name is not qualified by
  a subscript list, substring specification, and so on.  For example,
  if X is an array variable, the reference "X" is a named variable while
  the reference "X(1)" is an object designator.

'Named procedure' only appears in the title of Sec. 12.4.4.  This
section speaks of procedure resolution, and doesn't get into the
the definition of 'named procedure'.  If we extend the example to
'ptrfunction()', it would seem that 'ptrfunction' is a named 
procedure and 'ptrfunction()' is a reference to this procedure.

-- 
Steve

Re: [Patch, Fortran] (Coarray) Fix constraint checks for LOCK_TYPE

[Mikael Morin]

[-- Attachment #1: Type: Text/Plain, Size: 5257 bytes --]

OK, I played a bit myself to see what the "right way" would look like, and I 
came up with the attached patch, which is complicated, and not even correct. 
And indeed, it plays with allocatable and pointer stuff.
So your approach makes some sense now.

I do here some propositions for comment and error messages which IMO explain 
better where the problem lies (Iff I have understood the problem correctly). 
They are quite verbose however, and possibly not correct english (many 
negations). 
One could consider separating the "is LOCK_TYPE type" and "type has type 
LOCK_TYPE components" cases to make the diagnostic easier to read, but that 
would make the code even more complex.
Anyway comments and propositions welcome. 

review, 2nd try:
> diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
> index 2910ab5..9f732e5 100644
> --- a/gcc/fortran/parse.c
> +++ b/gcc/fortran/parse.c
> @@ -2148,15 +2157,61 @@ 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.codimension)
- Err, is the codimension attribute on the derived type?
Or did you mean [...] && c->ts.u.derived->attr.coarray_comp (to match the code 
removed)?
> +	{
> +	  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;
> +	}
> +
> +      /* F2008, C1302.  */
> +
Additional comment:
/* 5.3.14: An entity with the pointer attribute shall not be a coarray.
   2.4.7: A subobject of a coarray is a coarray if it doesn't have any pointer
   component selection.  */
> +      if (pointer && !coarray && (lock_type
> +				  || (c->ts.type == BT_DERIVED
> +				      && c->ts.u.derived->attr.lock_comp)))
> +	gfc_error ("Component %s at %L of type LOCK_TYPE or with subcomponent "
> +		   "of type LOCK_TYPE is a pointer but not a coarray",
> +		   c->name, &c->loc);
"Component %s at %L can be neither a coarray as it is a pointer, nor a non-
coarray as it would be a non-coarray of type LOCK_TYPE or would have a non-
coarray subcomponent of type LOCK_TYPE", c->name, &c->loc

> +
/* 2.4.7: A subobject of a coarray is a coarray if it doesn't have any
   allocatable component selection. 
   Thus, an allocatable component has to be a coarray for its subcomponents to
   be coarrays.  */
> +      if (lock_type && allocatable && !coarray)
- If lock_type && allocatable is true, then subcomponents of type LOCK_TYPE 
are discarded (cf the condition above for lock_type = 1), is that right?
I don't think you have this case in the tests you proposed.

> +	gfc_error ("Component %s at %L of type LOCK_TYPE or with subcomponent "
> +		   "of type LOCK_TYPE is allocatable but not a "
> +		   "coarray", c->name, &c->loc);
"Allocatable component %s at %L can't be a non-coarray as it would be a non-
coarray of type LOCK_TYPE or it would have a non-coarray sub-component of type 
LOCK_TYPE"

> +
/* 5.3.6: An entity whose type has a coarray ultimate component shall not be a
   coarray.  */
> +      if (sym->attr.coarray_comp && !coarray && lock_type)
> +	gfc_error ("Component %s at %L of type LOCK_TYPE or with subcomponent "
> +		   "of type LOCK_TYPE is not a coarray, but other coarray "
> +		   "components exist", c->name, &c->loc);
"An entity of type %s at %L can be neither a coarray as it has a coarray 
sub-component, nor a non-coarray as its sub-component %s would be a non-
coarray of type LOCK_TYPE or would have a non-coarray sub-component of type 
LOCK_TYPE"

> +
> +      if (sym->attr.lock_comp && coarray && !lock_type)
> +	gfc_error ("Component %s at %L of type LOCK_TYPE or with subcomponent "
> +		   "of type LOCK_TYPE has to be a coarray as %s at %L has a "
> +		   "codimension", lock_comp->name, &lock_comp->loc, c->name,
> +		   &c->loc);
"An entity of type %s at %L can be neither a coarray as its component %s at %L 
has a codimension, nor a non-coarray as its component %s at %L would be a
non-coarray of type LOCK_TYPE or would have a non-coarray sub-component of 
type LOCK_TYPE"

>  
>        /* Look for private components.  */
>        if (sym->component_access == ACCESS_PRIVATE

The rest looks good.

Mikael

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

diff --git a/gfortran.h b/gfortran.h
index acfa9d4..e03f172 100644
--- a/gfortran.h
+++ b/gfortran.h
@@ -786,6 +786,8 @@ typedef struct
 
   /* The namespace where the attribute has been set.  */
   struct gfc_namespace *volatile_ns, *asynchronous_ns;
+
+  const char *lock_comp_ref, *noncoarray_lock_comp_ref;
 }
 symbol_attribute;
 
diff --git a/resolve.c b/resolve.c
index b8a8ebb..fedad13 100644
--- a/resolve.c
+++ b/resolve.c
@@ -12087,6 +12087,112 @@ resolve_fl_parameter (gfc_symbol *sym)
 }
 
 
+static bool
+is_type_lock_type (gfc_typespec *ts)
+{
+  return (ts->type == BT_DERIVED
+	  && ts->u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
+	  && ts->u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE);
+}
+
+
+static const char *
+set_subref_str (const char **dest, const char *base_name,
+		const char *subref)
+{
+  const unsigned int bufflen = strlen(base_name) + strlen(subref) + 2;
+  char *str;
+
+  if (subref == NULL || !strcmp (subref, ""))
+    return NULL;
+    
+  str = XCNEWVEC (char, bufflen);
+  snprintf (str, bufflen, "%s%%%s", base_name, subref);
+  *dest = str;
+  return *dest;
+}
+
+
+static const char *comp_pick_lock_comp (gfc_component *);
+
+static const char *
+type_pick_lock_comp (gfc_symbol *derived)
+{
+  gfc_component *c;
+  const char *str;
+
+  if (derived->attr.lock_comp_ref != NULL)
+    return derived->attr.lock_comp_ref;
+
+  for (c = derived->components; c; c = c->next)
+    {
+      str = set_subref_str (&c->attr.lock_comp_ref, c->name,
+			    comp_pick_lock_comp (c));
+      if (str != NULL)
+	return str;
+    }
+
+  derived->attr.lock_comp_ref = "";
+  return derived->attr.lock_comp_ref;
+}
+
+
+static const char *
+type_pick_noncoarray_lock_comp (gfc_symbol *derived)
+{
+  gfc_component *c;
+  gfc_typespec *ts;
+  const char *str;
+
+  if (derived->attr.noncoarray_lock_comp_ref != NULL)
+    return derived->attr.noncoarray_lock_comp_ref;
+
+  for (c = derived->components; c; c = c->next)
+    {
+      ts = &c->ts;
+      if (ts->type != BT_DERIVED)
+	continue;
+
+      if (!c->attr.codimension && is_type_lock_type (&c->ts))
+	{
+	  c->attr.noncoarray_lock_comp_ref = gfc_get_string (c->name);
+	  return c->attr.noncoarray_lock_comp_ref;
+	}
+
+      if (c->attr.pointer || c->attr.allocatable)
+	{
+	  str = set_subref_str (&c->attr.noncoarray_lock_comp_ref, 
+				c->name, comp_pick_lock_comp (c));
+	  if (str != NULL)
+	    return str;
+	}
+      else
+	{
+	  str = set_subref_str (&c->attr.noncoarray_lock_comp_ref, c->name,
+				type_pick_noncoarray_lock_comp (c->ts.u.derived));
+	  if (str != NULL)
+	    return str;
+	}
+    }
+
+  derived->attr.noncoarray_lock_comp_ref = "";
+  return derived->attr.noncoarray_lock_comp_ref;
+}
+
+
+static const char *
+comp_pick_lock_comp (gfc_component *comp)
+{
+  if (comp->ts.type != BT_DERIVED)
+    return NULL;
+
+  if (is_type_lock_type (&comp->ts))
+    return gfc_get_string (comp->name);
+
+  return type_pick_lock_comp (comp->ts.u.derived);
+}
+
+
 /* Do anything necessary to resolve a symbol.  Right now, we just
    assume that an otherwise unknown symbol is a variable.  This sort
    of thing commonly happens for symbols in module.  */
@@ -12403,15 +12509,28 @@ resolve_symbol (gfc_symbol *sym)
 			 sym->ts.u.derived->name) == FAILURE)
     return;
 
-  /* F2008, C1302.  */
-  if (sym->ts.type == BT_DERIVED
-      && sym->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
-      && sym->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE
-      && !sym->attr.codimension)
+  if (!sym->attr.codimension)
     {
-      gfc_error ("Variable '%s' at %L of type LOCK_TYPE must be a coarray",
-		 sym->name, &sym->declared_at);
-      return;
+      if (is_type_lock_type (&sym->ts))
+	{
+	  gfc_error ("Variable '%s' at %L must be a coarray as it is of type "
+		     "LOCK_TYPE", sym->name, &sym->declared_at);
+	  return;
+	}
+      else if (sym->ts.type == BT_DERIVED)
+	{
+	  const char *comp_ref =
+		  type_pick_noncoarray_lock_comp (sym->ts.u.derived);
+	
+	  if (strcmp (comp_ref, "") != 0) 
+	    {
+	      gfc_error ("Variable '%s' at %L must be a coarray as its "
+			 "sub-component '%s%%%s' is a non-coarray of type "
+			 "LOCK_TYPE.", sym->name, &sym->declared_at, sym->name,
+			 comp_ref);
+	      return;
+	    }
+	}
     }
 
   /* An assumed-size array with INTENT(OUT) shall not be of a type for which

Re: [Patch, Fortran] (Coarray) Fix constraint checks for LOCK_TYPE

[Tobias Burnus]

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

On 05 August 2011 16:42, Mikael Morin wrote:
> OK, I played a bit myself to see what the "right way" would look like, and I
> came up with the attached patch, which is complicated, and not even correct.
> And indeed, it plays with allocatable and pointer stuff.
> So your approach makes some sense now.
>
> I do here some propositions for comment and error messages which IMO explain
> better where the problem lies (Iff I have understood the problem correctly).
> They are quite verbose however, and possibly not correct english (many
> negations).

Thanks for reviewing the patch and for the suggestions!

Attached is an updated version of the patch, I hope it is now better, 
though I think there is still room for improvement.

Changes:
- coarray_lock_5.f90: Added subroutine test2 with several additional 
test cases
- updated dg-error
- parse.c's parse_derived: Add one comment, updated all error texts, 
fixed codimension -> coarray_comp bug, added missing check and split 
some of the checks into LOCK_TYPE and lock_comp.

Build and regtested on x86-64-linux.
OK - or suggestions how to improve it further?

Tobias

[-- Attachment #2: lock-check-v3.diff --]
[-- Type: text/x-patch, Size: 14057 bytes --]

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.

diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 2910ab5..dc619c3 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 ("Pointer 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 be 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
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 7557ab8..53234fa 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -6806,7 +6806,7 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code)
 
       /* Check F2008, C642.  */
       if (code->expr3->ts.type == BT_DERIVED
-	  && ((codimension &&  gfc_expr_attr (code->expr3).lock_comp)
+	  && ((codimension && gfc_expr_attr (code->expr3).lock_comp)
 	      || (code->expr3->ts.u.derived->from_intmod
 		     == INTMOD_ISO_FORTRAN_ENV
 		  && code->expr3->ts.u.derived->intmod_sym_id
@@ -8224,10 +8224,9 @@ resolve_lock_unlock (gfc_code *code)
       || code->expr1->ts.u.derived->from_intmod != INTMOD_ISO_FORTRAN_ENV
       || code->expr1->ts.u.derived->intmod_sym_id != ISOFORTRAN_LOCK_TYPE
       || code->expr1->rank != 0
-      || !(gfc_expr_attr (code->expr1).codimension
-	   || gfc_is_coindexed (code->expr1)))
-    gfc_error ("Lock variable at %L must be a scalar coarray of type "
-	       "LOCK_TYPE", &code->expr1->where);
+      || (!gfc_is_coarray (code->expr1) && !gfc_is_coindexed (code->expr1)))
+    gfc_error ("Lock variable at %L must be a scalar of type LOCK_TYPE",
+	       &code->expr1->where);
 
   /* Check STAT.  */
   if (code->expr2
@@ -12221,12 +12220,14 @@ resolve_symbol (gfc_symbol *sym)
 
   /* F2008, C1302.  */
   if (sym->ts.type == BT_DERIVED
-      && sym->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
-      && sym->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE
-      && !sym->attr.codimension)
+      && ((sym->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
+	   && sym->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE)
+	  || sym->ts.u.derived->attr.lock_comp)
+      && !sym->attr.codimension && !sym->ts.u.derived->attr.coarray_comp)
     {
-      gfc_error ("Variable '%s' at %L of type LOCK_TYPE must be a coarray",
-		 sym->name, &sym->declared_at);
+      gfc_error ("Variable %s at %L of type LOCK_TYPE or with subcomponent of "
+		 "type LOCK_TYPE must be a coarray", sym->name,
+		 &sym->declared_at);
       return;
     }
 
diff --git a/gcc/testsuite/gfortran.dg/coarray_lock_1.f90 b/gcc/testsuite/gfortran.dg/coarray_lock_1.f90
index f9ef581..419ba47 100644
--- a/gcc/testsuite/gfortran.dg/coarray_lock_1.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_lock_1.f90
@@ -10,6 +10,6 @@ integer :: s
 character(len=3) :: c
 logical :: bool
 
-LOCK (a, stat=s, acquired_lock=bool, errmsg=c) ! { dg-error "must be a scalar coarray of type LOCK_TYPE" }
-UNLOCK (a, stat=s, errmsg=c) ! { dg-error "must be a scalar coarray of type LOCK_TYPE" }
+LOCK (a, stat=s, acquired_lock=bool, errmsg=c) ! { dg-error "must be a scalar of type LOCK_TYPE" }
+UNLOCK (a, stat=s, errmsg=c) ! { dg-error "must be a scalar of type LOCK_TYPE" }
 end
diff --git a/gcc/testsuite/gfortran.dg/coarray_lock_3.f90 b/gcc/testsuite/gfortran.dg/coarray_lock_3.f90
index b23d87e..958cee4 100644
--- a/gcc/testsuite/gfortran.dg/coarray_lock_3.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_lock_3.f90
@@ -19,11 +19,21 @@ module m
   type t
     type(lock_type), allocatable :: x(:)[:]
   end type t
+end module m
 
+module m2
+  use iso_fortran_env
   type t2
-    type(lock_type), allocatable :: x
+    type(lock_type), allocatable :: x ! { dg-error "Allocatable component x at .1. of type LOCK_TYPE must have a codimension" }
   end type t2
-end module m
+end module m2
+
+module m3
+  use iso_fortran_env
+  type t3
+    type(lock_type) :: x ! OK
+  end type t3
+end module m3
 
 subroutine sub(x)
   use iso_fortran_env
@@ -46,15 +56,15 @@ subroutine sub3(x) ! { dg-error "with coarray component shall be a nonpointer, n
 end subroutine sub3
 
 subroutine sub4(x)
-  use m
-  type(t2), intent(inout) :: x[*] ! OK
+  use m3
+  type(t3), intent(inout) :: x[*] ! OK
 end subroutine sub4
 
 subroutine lock_test
   use iso_fortran_env
   type t
   end type t
-  type(lock_type) :: lock ! { dg-error "type LOCK_TYPE must be a coarray" }
+  type(lock_type) :: lock ! { dg-error "of type LOCK_TYPE or with subcomponent of type LOCK_TYPE must be a coarray" }
 end subroutine lock_test
 
 subroutine lock_test2
@@ -65,10 +75,10 @@ subroutine lock_test2
   type(t) :: x
   type(lock_type), save :: lock[*],lock2(2)[*]
   lock(t) ! { dg-error "Syntax error in LOCK statement" }
-  lock(x) ! { dg-error "must be a scalar coarray of type LOCK_TYPE" }
+  lock(x) ! { dg-error "must be a scalar of type LOCK_TYPE" }
   lock(lock)
   lock(lock2(1))
-  lock(lock2) ! { dg-error "must be a scalar coarray of type LOCK_TYPE" }
+  lock(lock2) ! { dg-error "must be a scalar of type LOCK_TYPE" }
   lock(lock[1]) ! OK
 end subroutine lock_test2
 
@@ -104,4 +114,4 @@ contains
   end subroutine test
 end subroutine argument_check
 
-! { dg-final { cleanup-modules "m" } }
+! { dg-final { cleanup-modules "m m2 m3" } }
--- /dev/null	2011-08-17 07:24:12.871882230 +0200
+++ gcc/gcc/testsuite/gfortran.dg/coarray_lock_4.f90	2011-08-17 23:22:12.000000000 +0200
@@ -0,0 +1,64 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+!
+!
+! LOCK/LOCK_TYPE checks 
+!
+
+subroutine valid()
+  use iso_fortran_env
+  implicit none
+  type t
+    type(lock_type) :: lock
+  end type t
+
+  type t2
+    type(lock_type), allocatable :: lock(:)[:]
+  end type t2
+
+  type(t), save :: a[*]
+  type(t2), save :: b ! OK
+
+  allocate(b%lock(1)[*])
+  LOCK(a%lock) ! OK
+  LOCK(a[1]%lock) ! OK
+
+  LOCK(b%lock(1)) ! OK
+  LOCK(b%lock(1)[1]) ! OK
+end subroutine valid
+
+subroutine invalid()
+  use iso_fortran_env
+  implicit none
+  type t
+    type(lock_type) :: lock
+  end type t
+  type(t), save :: a ! { dg-error "type LOCK_TYPE or with subcomponent of type LOCK_TYPE must be a coarray" }
+end subroutine invalid
+
+subroutine more_tests
+  use iso_fortran_env
+  implicit none
+  type t
+    type(lock_type) :: a ! OK
+  end type t
+
+  type t1
+    type(lock_type), allocatable :: c2(:)[:] ! OK 
+  end type t1
+  type(t1) :: x1 ! OK
+
+  type t2
+    type(lock_type), allocatable :: c1(:) ! { dg-error "Allocatable component c1 at .1. of type LOCK_TYPE must have a codimension" }
+  end type t2
+
+  type t3
+    type(t) :: b
+  end type t3
+  type(t3) :: x3 ! { dg-error "of type LOCK_TYPE or with subcomponent of type LOCK_TYPE must be a coarray" }
+
+  type t4
+    type(lock_type) :: c0(2)
+  end type t4
+  type(t4) :: x4 ! { dg-error "of type LOCK_TYPE or with subcomponent of type LOCK_TYPE must be a coarray" }
+end subroutine more_tests
--- /dev/null	2011-08-17 07:24:12.871882230 +0200
+++ gcc/gcc/testsuite/gfortran.dg/coarray_lock_5.f90	2011-08-18 00:36:23.000000000 +0200
@@ -0,0 +1,53 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+!
+! LOCK_TYPE checks
+!
+module m3
+  use iso_fortran_env
+  type, extends(lock_type) :: lock
+    integer :: j = 7
+  end type lock
+end module m3
+
+use m3
+type(lock_type) :: tl[*] = lock_type ()
+type(lock) :: t[*]
+tl = lock_type () ! { dg-error "variable definition context" }
+print *,t%j
+end
+
+subroutine test()
+  use iso_fortran_env
+  type t
+    type(lock_type) :: lock
+  end type t
+
+  type t2
+    type(t), pointer :: x ! { dg-error "Pointer component x at .1. has a noncoarray subcomponent of type LOCK_TYPE, which must be have a codimension or be a subcomponent of a coarray" }
+  end type t2
+end subroutine test
+
+subroutine test2()
+  use iso_fortran_env
+  implicit none
+  type t
+    type(lock_type), allocatable :: lock ! { dg-error "Allocatable component lock at .1. of type LOCK_TYPE must have a codimension" }
+  end type t
+  type t2
+    type(lock_type) :: lock
+  end type t2
+  type t3
+    type(t2), allocatable :: lock_cmp
+  end type t3
+  type t4
+    integer, allocatable :: a[:]
+    type(t2) :: b ! { dg-error "Noncoarray component b at .1. 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 t4 may not have a codimension as already a coarray subcomponent exists." }
+  end type t4
+  type t5
+    type(t2) :: c ! { dg-error "Noncoarray component c at .1. 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 t5 may not have a codimension as d at .2. has a codimension or a coarray subcomponent." }
+    integer, allocatable :: d[:] ! { dg-error "Noncoarray component c at .1. 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 t5 may not have a codimension as d at .2. has a codimension or a coarray subcomponent." }
+  end type t5
+end subroutine test2
+
+! { dg-final { cleanup-modules "m3" } }

Re: [Patch, Fortran] (Coarray) Fix constraint checks for LOCK_TYPE

[Mikael Morin]

Hello,

Two nits below...

On Thursday 18 August 2011 00:50:29 Tobias Burnus wrote:
> diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
> index 2910ab5..dc619c3 100644
> --- a/gcc/fortran/parse.c
> +++ b/gcc/fortran/parse.c
> @@ -2148,15 +2157,76 @@ endType:
[...]
> +
> +    /* 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 ("Pointer 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);
I think one could drop the first "Pointer" as it is present at the end of the 
sentence: `Component %s at %L of type...'

> +    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 be have a codimension or be a "
> +                 "subcomponent of a coarray", c->name, &c->loc);
There is one verb too many -> `which must <be removed> have a codimension...'


> Thanks for reviewing the patch and for the suggestions!
> 
> Attached is an updated version of the patch, I hope it is now better,
I think it is. The fact that I understand better the problem probably helps 
too. ;-)

> though I think there is still room for improvement.
well, the conditions are difficult to express anyway.

> 
> Changes:
> - coarray_lock_5.f90: Added subroutine test2 with several additional
> test cases
> - updated dg-error
> - parse.c's parse_derived: Add one comment, updated all error texts,
> fixed codimension -> coarray_comp bug, added missing check and split
> some of the checks into LOCK_TYPE and lock_comp.
> 
> Build and regtested on x86-64-linux.
> OK - or suggestions how to improve it further?
OK with the two nits above fixed. Thanks.

Mikael

Re: [Patch, Fortran] (Coarray) Fix constraint checks for LOCK_TYPE

[Tobias Burnus]

On 08/18/2011 03:16 PM, Mikael Morin wrote:
> OK with the two nits above fixed.

Thanks for the review and the making the wording less incomprehensible. 
Committed as Rev. 177867.

The single-image coarray is slowly becoming feature complete; I only 
have polymorphic coarrays and some fixes for derived-type assignments on 
my agenda. Hopefully, multi-image coarray support will also become 
usable in a couple of months.

Furthermore, thanks for the review of the namelist patch.

Tobias