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 | d2488c9a94082482616e784882464dcd57286e12 (patch) | |
tree | 89b5727b5890b0456c8e2256d6bc91ea74d41668 | |
parent | 11e25d81adc657554bb2903f8c013ca93b332e61 (diff) |
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.
git-svn-id: https://gcc.gnu.org/svn/gcc/trunk@161504 138bc75d-0d04-0410-961f-82ee72b054a4
-rw-r--r-- | gcc/fortran/ChangeLog | 7 | ||||
-rw-r--r-- | gcc/fortran/interface.c | 34 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/actual_rank_check_1.f90 | 23 |
4 files changed, 63 insertions, 6 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 6fbac64a2db..60d1e31876a 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +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 Nathan Froyd <froydnj@codesourcery.com> * trans-openmp.c (dovar_init): Define. Define VECs containing it. diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index ee164fc6d1a..587b09cdf8c 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; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index ffec3e5ea85..e17bb03627d 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2010-06-28 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/40158 + * gfortran.dg/actual_rank_check_1.f90: New test. + 2010-06-28 Martin Jambor <mjambor@suse.cz> * testsuite/gcc.dg/ipa/ipa-sra-6.c: New test. diff --git a/gcc/testsuite/gfortran.dg/actual_rank_check_1.f90 b/gcc/testsuite/gfortran.dg/actual_rank_check_1.f90 new file mode 100644 index 00000000000..7167de4270c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/actual_rank_check_1.f90 @@ -0,0 +1,23 @@ +! { dg-do compile } +! Test the fix for PR40158, where the errro message was not clear about scalars. +! +! Contributed by Tobias Burnus <burnus@gcc.gnu.org> +! + implicit none + integer :: i(4,5),j + i = 0 + call sub1(i) + call sub1(j) ! { dg-error "rank-1 and scalar" } + call sub2(i) ! { dg-error "scalar and rank-2" } + call sub2(j) + print '(5i0)', i +contains + subroutine sub1(i1) + integer :: i1(*) + i1(1) = 2 + end subroutine sub1 + subroutine sub2(i2) + integer :: i2 + i2 = 2 + end subroutine sub2 +end |