aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran
diff options
context:
space:
mode:
authorTobias Burnus <burnus@net-b.de>2011-07-19 18:46:02 +0200
committerTobias Burnus <burnus@gcc.gnu.org>2011-07-19 18:46:02 +0200
commit394d3a2e8dedb9fd95bb82bf1647b7b445ff41c3 (patch)
treebaf3e502e46310d6a93f6c8c323e08c5eec38cbb /gcc/fortran
parent9dafd06325174321a2d27627b9fe65ad6515d750 (diff)
downloadgcc-394d3a2e8dedb9fd95bb82bf1647b7b445ff41c3.zip
gcc-394d3a2e8dedb9fd95bb82bf1647b7b445ff41c3.tar.gz
gcc-394d3a2e8dedb9fd95bb82bf1647b7b445ff41c3.tar.bz2
expr.c (gfc_is_coarray): New function.
2011-07-19 Tobias Burnus <burnus@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-19 Tobias Burnus <burnus@net-b.de> * gfortran.dg/coarray_args_1.f90: New. * gfortran.dg/coarray_args_2.f90: New. From-SVN: r176467
Diffstat (limited to 'gcc/fortran')
-rw-r--r--gcc/fortran/ChangeLog6
-rw-r--r--gcc/fortran/expr.c67
-rw-r--r--gcc/fortran/gfortran.h1
-rw-r--r--gcc/fortran/interface.c52
4 files changed, 91 insertions, 35 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index b3019f3..bf91112 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2011-07-19 Tobias Burnus <burnus@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-19 Richard Guenther <rguenther@suse.de>
* trans-expr.c (fill_with_spaces): Use fold_build_pointer_plus.
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index b8eb555..e5394b8 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -4154,6 +4154,73 @@ 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)
+ 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..acb5400 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2735,6 +2735,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..482a75e 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -1557,47 +1557,26 @@ 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 &&
- ((last && last->u.c.component->as->corank != formal->as->corank)
- || (!last
- && actual->symtree->n.sym->as->corank != formal->as->corank)))
+ if ((last && last->u.c.component->as->corank != formal->as->corank)
+ || (!last
+ && actual->symtree->n.sym->as->corank != formal->as->corank))
{
if (where)
gfc_error ("Corank mismatch in argument '%s' at %L (%d and %d)",
@@ -1606,7 +1585,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 +1615,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
formal->name, &actual->where);
return 0;
}
- }
+ }
/* F2008, C1239/C1240. */
if (actual->expr_type == EXPR_VARIABLE