diff options
| author | burnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2015-01-26 21:12:19 +0000 |
|---|---|---|
| committer | burnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2015-01-26 21:12:19 +0000 |
| commit | 1b4c7a08098e13a34eeab8b380e1f1324054e068 (patch) | |
| tree | c3c65b84bda2dd5d66a147c222c325042311cdf9 /gcc/fortran/interface.c | |
| parent | 194f825090644b60b42aaff354bfba48f7997249 (diff) | |
2015-01-26 Tobias Burnus <burnus@net-b.de>
PR fortran/64771
gcc/fortran/
* interface.c (check_dummy_characteristics): Fix coarray
* handling.
testsuite/
* gfortran.dg/coarray_36.f: New.
* gfortran.dg/coarray_37.f90: New.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@220136 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/fortran/interface.c')
| -rw-r--r-- | gcc/fortran/interface.c | 19 |
1 files changed, 16 insertions, 3 deletions
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index dd3ad2a0cd21..0463a58fa7f6 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -63,6 +63,8 @@ along with GCC; see the file COPYING3. If not see formal argument list points to symbols within the same namespace as the program unit name. */ +#include <algorithm> /* For std::max. */ + #include "config.h" #include "system.h" #include "coretypes.h" @@ -1205,8 +1207,15 @@ check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2, return false; } + if (s1->as->corank != s2->as->corank) + { + snprintf (errmsg, err_len, "Corank mismatch in argument '%s' (%i/%i)", + s1->name, s1->as->corank, s2->as->corank); + return false; + } + if (s1->as->type == AS_EXPLICIT) - for (i = 0; i < s1->as->rank + s1->as->corank; i++) + for (i = 0; i < s1->as->rank + std::max(0, s1->as->corank-1); i++) { shape1 = gfc_subtract (gfc_copy_expr (s1->as->upper[i]), gfc_copy_expr (s1->as->lower[i])); @@ -1220,8 +1229,12 @@ check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2, case -1: case 1: case -3: - snprintf (errmsg, err_len, "Shape mismatch in dimension %i of " - "argument '%s'", i + 1, s1->name); + if (i < s1->as->rank) + snprintf (errmsg, err_len, "Shape mismatch in dimension %i of" + " argument '%s'", i + 1, s1->name); + else + snprintf (errmsg, err_len, "Shape mismatch in codimension %i " + "of argument '%s'", i - s1->as->rank + 1, s1->name); return false; case -2: |