This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
Re: [Patch, Fortran] (Coarray) Fix constraint checks for LOCK_TYPE
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
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" } }