Patchwork [Fortran] (Coarray) Fix constraint checks for LOCK_TYPE

login
register
mail settings
Submitter Tobias Burnus
Date Aug. 17, 2011, 10:50 p.m.
Message ID <4E4C45B5.2090302@net-b.de>
Download mbox | patch
Permalink /patch/110428/
State New
Headers show

Comments

Tobias Burnus - Aug. 17, 2011, 10:50 p.m.
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
Mikael Morin - Aug. 18, 2011, 1:16 p.m.
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
Tobias Burnus - Aug. 18, 2011, 3:19 p.m.
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

Patch

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" } }