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
2011-08-18 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-18 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.
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" } }
