diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2010-06-28 17:16:06 +0000 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2010-06-28 17:16:06 +0000 |
| commit | a516520c2b74a6ec461f6b30c22b5edd996a4a8b (patch) | |
| tree | 89b5727b5890b0456c8e2256d6bc91ea74d41668 /gcc/fortran/interface.c | |
| parent | bb8e5dcaa4c07a9aece8b608242d0c0b8d061eba (diff) | |
| download | gcc-a516520c2b74a6ec461f6b30c22b5edd996a4a8b.zip gcc-a516520c2b74a6ec461f6b30c22b5edd996a4a8b.tar.gz gcc-a516520c2b74a6ec461f6b30c22b5edd996a4a8b.tar.bz2 | |
re PR fortran/40158 (Misleading error message for passing a scalar to an array)
2010-06-28 Paul Thomas <pault@gcc.gnu.org>
PR fortran/40158
* interface.c (argument_rank_mismatch): New function.
(compare_parameter): Call new function instead of generating
the error directly.
2010-06-28 Paul Thomas <pault@gcc.gnu.org>
PR fortran/40158
* gfortran.dg/actual_rank_check_1.f90: New test.
From-SVN: r161504
Diffstat (limited to 'gcc/fortran/interface.c')
| -rw-r--r-- | gcc/fortran/interface.c | 34 |
1 files changed, 28 insertions, 6 deletions
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index ee164fc..587b09c 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -1376,6 +1376,30 @@ compare_pointer (gfc_symbol *formal, gfc_expr *actual) } +/* Emit clear error messages for rank mismatch. */ + +static void +argument_rank_mismatch (const char *name, locus *where, + int rank1, int rank2) +{ + if (rank1 == 0) + { + gfc_error ("Rank mismatch in argument '%s' at %L " + "(scalar and rank-%d)", name, where, rank2); + } + else if (rank2 == 0) + { + gfc_error ("Rank mismatch in argument '%s' at %L " + "(rank-%d and scalar)", name, where, rank1); + } + else + { + gfc_error ("Rank mismatch in argument '%s' at %L " + "(rank-%d and rank-%d)", name, where, rank1, rank2); + } +} + + /* Given a symbol of a formal argument list and an expression, see if the two are compatible as arguments. Returns nonzero if compatible, zero if not compatible. */ @@ -1559,9 +1583,8 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, && gfc_is_coindexed (actual))) { if (where) - gfc_error ("Rank mismatch in argument '%s' at %L (%d and %d)", - formal->name, &actual->where, symbol_rank (formal), - actual->rank); + argument_rank_mismatch (formal->name, &actual->where, + symbol_rank (formal), actual->rank); return 0; } else if (actual->rank != 0 && (is_elemental || formal->attr.dimension)) @@ -1600,9 +1623,8 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, else if (ref == NULL && actual->expr_type != EXPR_NULL) { if (where) - gfc_error ("Rank mismatch in argument '%s' at %L (%d and %d)", - formal->name, &actual->where, symbol_rank (formal), - actual->rank); + argument_rank_mismatch (formal->name, &actual->where, + symbol_rank (formal), actual->rank); return 0; } |