diff options
| author | Tobias Burnus <burnus@net-b.de> | 2015-01-26 22:12:19 +0100 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2015-01-26 22:12:19 +0100 |
| commit | b25affbdc1fab885366de251e04e2e56d0b4f6cc (patch) | |
| tree | c3c65b84bda2dd5d66a147c222c325042311cdf9 /gcc/fortran/interface.c | |
| parent | c123c5ba64cc59cceb71594b415c75c1f7618349 (diff) | |
| download | gcc-b25affbdc1fab885366de251e04e2e56d0b4f6cc.zip gcc-b25affbdc1fab885366de251e04e2e56d0b4f6cc.tar.gz gcc-b25affbdc1fab885366de251e04e2e56d0b4f6cc.tar.bz2 | |
re PR fortran/64771 (ICE(segfault) when passing coarrays around; ICE in gfc_zero_size_array in arith.c:1637)
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.
From-SVN: r220136
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 dd3ad2a..0463a58 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: |