diff options
| author | Tobias Burnus <burnus@net-b.de> | 2011-07-19 18:46:02 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2011-07-19 18:46:02 +0200 |
| commit | 394d3a2e8dedb9fd95bb82bf1647b7b445ff41c3 (patch) | |
| tree | baf3e502e46310d6a93f6c8c323e08c5eec38cbb /gcc/fortran/interface.c | |
| parent | 9dafd06325174321a2d27627b9fe65ad6515d750 (diff) | |
| download | gcc-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/interface.c')
| -rw-r--r-- | gcc/fortran/interface.c | 52 |
1 files changed, 17 insertions, 35 deletions
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 |