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.
@@ -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
@@ -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;
}
@@ -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
@@ -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" } }
@@ -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
@@ -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" } }