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)"
2011-08-02 Tobias Burnus <bur...@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 <bur...@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" } }
