diff options
| author | Steven G. Kargl <kargls@comcast.net> | 2005-03-05 22:13:21 +0000 |
|---|---|---|
| committer | Steven G. Kargl <kargl@gcc.gnu.org> | 2005-03-05 22:13:21 +0000 |
| commit | 2c5ed587af06d261341f11f1e871c7e4de4a2960 (patch) | |
| tree | 09baa1aa36a69fa114dc4b806b048ac94c613806 | |
| parent | 098c1ef8fa64e121080ac29b6afdab9d27527c04 (diff) | |
| download | gcc-2c5ed587af06d261341f11f1e871c7e4de4a2960.zip gcc-2c5ed587af06d261341f11f1e871c7e4de4a2960.tar.gz gcc-2c5ed587af06d261341f11f1e871c7e4de4a2960.tar.bz2 | |
re PR fortran/19754 (Shape conformance not checked)
PR fortran/19754
* resolve.c (compare_shapes): New function.
(resolve_operator): Use it.
From-SVN: r95945
| -rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 40 |
2 files changed, 44 insertions, 2 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 1490ed1..514b29a 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2005-03-05 Steven G. Kargl <kargls@comcast.net> + + PR fortran/19754 + * resolve.c (compare_shapes): New function. + (resolve_operator): Use it. + 2005-03-05 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de> * trans-const.c (gfc_conv_constant_to_tree): Use correct tree diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 4d98f46..126f21f 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1249,6 +1249,36 @@ resolve_call (gfc_code * c) return t; } +/* Compare the shapes of two arrays that have non-NULL shapes. If both + op1->shape and op2->shape are non-NULL return SUCCESS if their shapes + match. If both op1->shape and op2->shape are non-NULL return FAILURE + if their shapes do not match. If either op1->shape or op2->shape is + NULL, return SUCCESS. */ + +static try +compare_shapes (gfc_expr * op1, gfc_expr * op2) +{ + try t; + int i; + + t = SUCCESS; + + if (op1->shape != NULL && op2->shape != NULL) + { + for (i = 0; i < op1->rank; i++) + { + if (mpz_cmp (op1->shape[i], op2->shape[i]) != 0) + { + gfc_error ("Shapes for operands at %L and %L are not conformable", + &op1->where, &op2->where); + t = FAILURE; + break; + } + } + } + + return t; +} /* Resolve an operator expression node. This can involve replacing the operation with a user defined function call. */ @@ -1460,10 +1490,14 @@ resolve_operator (gfc_expr * e) if (op1->rank == op2->rank) { e->rank = op1->rank; - if (e->shape == NULL) + { + t = compare_shapes(op1, op2); + if (t == FAILURE) + e->shape = NULL; + else e->shape = gfc_copy_shape (op1->shape, op1->rank); - + } } else { @@ -1499,10 +1533,12 @@ resolve_operator (gfc_expr * e) return t; bad_op: + if (gfc_extend_expr (e) == SUCCESS) return SUCCESS; gfc_error (msg, &e->where); + return FAILURE; } |