For the Fortran standard, quite a lot of objects are coarrays.
Essentially every object which as an attr.codimension - including array
sections, elements or components of it - unless the components are
allocatable or pointer. Note that this excludes coindexed objects. See
F2008, "2.4.7 Coarray".
For coarray dummy arguments, there are additional conditions, which
prevent the copy-in/copy-out. (See: "12.5.2.8 Coarray dummy variables").
As the coarray status is nontrivial to check, I have created a function
for that - and I use it now for the interface checking. There are more
cases, where the wrong check is used, leading to accepts-invalid and
rejects-valid issues; however, I would like to track them later.
I would be happy if someone could carefully read the function in expr.c
- and confirm that the second test case ("dg-error" line) is indeed
invalid. I think it is invalid because one has an array element of a
coarray, which is a coarray but which is not simply contiguous. Thus, if
possible cross check that it is indeed not simply contiguous.
Build and regtested on x86-64-linux.
OK for the trunk?
Tobias
2011-07-18 Tobias Burnus <bur...@net-b.de>
* expr.c (gfc_is_coarray): New function.
* gfortran.h (gfc_is_coarray): New prototype.
* interface.c (compare_parameter): Use it.
2011-07-18 Tobias Burnus <bur...@net-b.de>
* gfortran.dg/coarray_args_1.f90: New.
* gfortran.dg/coarray_args_2.f90: New.
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index b8eb555..67ac2e5 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -4154,6 +4154,74 @@ gfc_is_coindexed (gfc_expr *e)
}
+/* Coarrays are variables with a corank but not being coindexed. However, also
+ the following is a coarray: A subobject of a coarray is a coarray if it does
+ not have any cosubscripts, vector subscripts, allocatable component
+ selection, or pointer component selection. (F2008, 2.4.7) */
+
+bool
+gfc_is_coarray (gfc_expr *e)
+{
+ gfc_ref *ref;
+ gfc_symbol *sym;
+ gfc_component *comp;
+ bool coindexed;
+ bool coarray;
+ int i;
+
+ if (e->expr_type != EXPR_VARIABLE
+ && e->expr_type != EXPR_FUNCTION)
+ return false;
+
+ coindexed = false;
+ sym = e->symtree->n.sym;
+
+ if (sym->ts.type == BT_CLASS && sym->attr.class_ok)
+ coarray = CLASS_DATA (sym)->attr.codimension;
+ else
+ coarray = sym->attr.codimension;
+
+ for (ref = e->ref; ref; ref = ref->next)
+ switch (ref->type)
+ {
+ case REF_COMPONENT:
+ comp = ref->u.c.component;
+ if (comp->attr.pointer || comp->attr.allocatable)
+ {
+ coindexed = false;
+ if (comp->ts.type == BT_CLASS && comp->attr.class_ok)
+ coarray = CLASS_DATA (comp)->attr.codimension;
+ else
+ coarray = comp->attr.codimension;
+ }
+ break;
+
+ case REF_ARRAY:
+ if (!coarray)
+ break;
+
+ if (ref->u.ar.codimen > 0 && !gfc_ref_this_image (ref))
+ {
+ coindexed = true;
+ break;
+ }
+
+ for (i = 0; i < ref->u.ar.dimen; i++)
+ if (ref->u.ar.dimen_type[i] == DIMEN_VECTOR)
+ {
+ coarray = false;
+ break;
+ }
+ break;
+
+ case REF_SUBSTRING:
+ break;
+ }
+
+ return coarray && !coindexed;
+}
+
+
int
gfc_get_corank (gfc_expr *e)
{
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index eb01b0e..8fc69d9 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2735,6 +2736,7 @@ bool gfc_is_proc_ptr_comp (gfc_expr *, gfc_component **);
bool gfc_ref_this_image (gfc_ref *ref);
bool gfc_is_coindexed (gfc_expr *);
+bool gfc_is_coarray (gfc_expr *);
int gfc_get_corank (gfc_expr *);
bool gfc_has_ultimate_allocatable (gfc_expr *);
bool gfc_has_ultimate_pointer (gfc_expr *);
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index dcf6c4e..fa23de7 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -1557,41 +1557,21 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
}
}
- if (formal->attr.codimension)
+ if (formal->attr.codimension && !gfc_is_coarray (actual))
{
- gfc_ref *last = NULL;
-
- if (actual->expr_type != EXPR_VARIABLE
- || !gfc_expr_attr (actual).codimension)
- {
- if (where)
- gfc_error ("Actual argument to '%s' at %L must be a coarray",
+ if (where)
+ gfc_error ("Actual argument to '%s' at %L must be a coarray",
formal->name, &actual->where);
- return 0;
- }
+ return 0;
+ }
- if (gfc_is_coindexed (actual))
- {
- if (where)
- gfc_error ("Actual argument to '%s' at %L must be a coarray "
- "and not coindexed", formal->name, &actual->where);
- return 0;
- }
+ if (formal->attr.codimension && formal->attr.allocatable)
+ {
+ gfc_ref *last = NULL;
for (ref = actual->ref; ref; ref = ref->next)
- {
- if (ref->type == REF_ARRAY && ref->u.ar.as->corank
- && ref->u.ar.type != AR_FULL && ref->u.ar.dimen != 0)
- {
- if (where)
- gfc_error ("Actual argument to '%s' at %L must be a coarray "
- "and thus shall not have an array designator",
- formal->name, &ref->u.ar.where);
- return 0;
- }
- if (ref->type == REF_COMPONENT)
- last = ref;
- }
+ if (ref->type == REF_COMPONENT)
+ last = ref;
/* F2008, 12.5.2.6. */
if (formal->attr.allocatable &&
@@ -1606,7 +1586,10 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
: actual->symtree->n.sym->as->corank);
return 0;
}
+ }
+ if (formal->attr.codimension)
+ {
/* F2008, 12.5.2.8. */
if (formal->attr.dimension
&& (formal->attr.contiguous || formal->as->type != AS_ASSUMED_SHAPE)
@@ -1633,7 +1616,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
formal->name, &actual->where);
return 0;
}
- }
+ }
/* F2008, C1239/C1240. */
if (actual->expr_type == EXPR_VARIABLE
--- /dev/null 2011-07-18 07:46:52.518868366 +0200
+++ gcc/gcc/testsuite/gfortran.dg/coarray_args_1.f90 2011-07-18 10:08:58.000000000 +0200
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+!
+! Argument checking
+!
+ implicit none
+ type t
+ integer :: i
+ integer,allocatable :: j
+ end type t
+
+ type(t), save :: x[*]
+
+ call sub1(x%i)
+ call sub1(x[1]%i) ! { dg-error "must be a coarray" }
+contains
+ subroutine sub1(y)
+ integer :: y[*]
+ end subroutine sub1
+end
--- /dev/null 2011-07-18 07:46:52.518868366 +0200
+++ gcc/gcc/testsuite/gfortran.dg/coarray_args_2.f90 2011-07-18 18:59:48.000000000 +0200
@@ -0,0 +1,50 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+!
+! Check argument passing.
+! Taken from Reinhold Bader's fortran_tests.
+!
+
+module mod_rank_mismatch_02
+ implicit none
+ integer, parameter :: ndim = 2
+contains
+ subroutine subr(n,w)
+ integer :: n
+ real :: w(n,*)[*]
+
+ integer :: k, x
+
+ if (this_image() == 0) then
+ x = 1.0
+ do k = 1, num_images()
+ if (abs(w(2,1)[k] - x) > 1.0e-5) then
+ write(*, *) 'FAIL'
+ error stop
+ end if
+ x = x + 1.0
+ end do
+ end if
+
+ end subroutine
+end module
+
+program rank_mismatch_02
+ use mod_rank_mismatch_02
+ implicit none
+ real :: a(ndim,2)[*]
+
+ a = 0.0
+ a(2,2) = 1.0 * this_image()
+
+ sync all
+
+ call subr(ndim, a(1:1,2)) ! OK
+ call subr(ndim, a(1,2)) ! { dg-error "must be simply contiguous" }
+
+ if (this_image() == 1) then
+ write(*, *) 'OK'
+ end if
+end program
+
+! { dg-final { cleanup-modules "mod_rank_mismatch_02" } }
