Commit a516520c by Paul Thomas

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
parent bb8e5dca
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> 2010-06-28 Nathan Froyd <froydnj@codesourcery.com>
* trans-openmp.c (dovar_init): Define. Define VECs containing it. * trans-openmp.c (dovar_init): Define. Define VECs containing it.
......
...@@ -1376,6 +1376,30 @@ compare_pointer (gfc_symbol *formal, gfc_expr *actual) ...@@ -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 /* Given a symbol of a formal argument list and an expression, see if
the two are compatible as arguments. Returns nonzero if the two are compatible as arguments. Returns nonzero if
compatible, zero if not compatible. */ compatible, zero if not compatible. */
...@@ -1559,9 +1583,8 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, ...@@ -1559,9 +1583,8 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
&& gfc_is_coindexed (actual))) && gfc_is_coindexed (actual)))
{ {
if (where) if (where)
gfc_error ("Rank mismatch in argument '%s' at %L (%d and %d)", argument_rank_mismatch (formal->name, &actual->where,
formal->name, &actual->where, symbol_rank (formal), symbol_rank (formal), actual->rank);
actual->rank);
return 0; return 0;
} }
else if (actual->rank != 0 && (is_elemental || formal->attr.dimension)) else if (actual->rank != 0 && (is_elemental || formal->attr.dimension))
...@@ -1600,9 +1623,8 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, ...@@ -1600,9 +1623,8 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
else if (ref == NULL && actual->expr_type != EXPR_NULL) else if (ref == NULL && actual->expr_type != EXPR_NULL)
{ {
if (where) if (where)
gfc_error ("Rank mismatch in argument '%s' at %L (%d and %d)", argument_rank_mismatch (formal->name, &actual->where,
formal->name, &actual->where, symbol_rank (formal), symbol_rank (formal), actual->rank);
actual->rank);
return 0; return 0;
} }
......
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> 2010-06-28 Martin Jambor <mjambor@suse.cz>
* testsuite/gcc.dg/ipa/ipa-sra-6.c: New test. * testsuite/gcc.dg/ipa/ipa-sra-6.c: New test.
......
! { 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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment