diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 73dcbf87d8e94c2a058ec12e256b9ec5b782b25a..04844601fe13acd2dcdea96ea92bc5d44a85e895 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2007-09-13 Tobias Burnus <burnus@net-b.de>
+
+ PR fortran/33343
+ * expr.c (gfc_check_conformance): Print ranks in the error message.
+ * resolve.c (resolve_elemental_actual): Check also conformance of
+ the actual arguments for elemental functions.
+
2007-09-13 Tobias Burnus <burnus@net-b.de>
* symbol.c (gfc_add_elemental,gfc_add_pure,gfc_add_recursive):
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index ebed1f2283286066397e9c5770b8ca6579e67e06..6ffcf7ef63b721a1f1bb77729777f47aefcab9e4 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -2513,8 +2513,8 @@ gfc_check_conformance (const char *optype_msgid, gfc_expr *op1, gfc_expr *op2)
if (op1->rank != op2->rank)
{
- gfc_error ("Incompatible ranks in %s at %L", _(optype_msgid),
- &op1->where);
+ gfc_error ("Incompatible ranks in %s (%d and %d) at %L", _(optype_msgid),
+ op1->rank, op2->rank, &op1->where);
return FAILURE;
}
@@ -2527,7 +2527,7 @@ gfc_check_conformance (const char *optype_msgid, gfc_expr *op1, gfc_expr *op2)
if (op1_flag && op2_flag && mpz_cmp (op1_size, op2_size) != 0)
{
- gfc_error ("different shape for %s at %L on dimension %d (%d/%d)",
+ gfc_error ("different shape for %s at %L on dimension %d (%d and %d)",
_(optype_msgid), &op1->where, d + 1,
(int) mpz_get_si (op1_size),
(int) mpz_get_si (op2_size));
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 76a20a4cb5b4cf67faf472e6fd8e23069e6d3b95..55d087ff0892d921959c3f1b11519373238ed49f 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -1275,13 +1275,10 @@ resolve_elemental_actual (gfc_expr *expr, gfc_code *c)
if (resolve_assumed_size_actual (arg->expr))
return FAILURE;
- if (expr)
- continue;
-
- /* Elemental subroutine array actual arguments must conform. */
+ /* Elemental procedure's array actual arguments must conform. */
if (e != NULL)
{
- if (gfc_check_conformance ("elemental subroutine", arg->expr, e)
+ if (gfc_check_conformance ("elemental procedure", arg->expr, e)
== FAILURE)
return FAILURE;
}
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 9df45f8f49da86faa0c61185adabdb0bee6edbc2..90cbdad574b1bb52eac716e485e23632818a9fc4 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2007-09-13 Tobias Burnus <burnus@net-b.de>
+
+ PR fortran/33343
+ * gfortran.dg/elemental_args_check_1.f90: New.
+ * gfortran.dg/assumed_size_refs_1.f90: Update error message.
+ * gfortran.dg/elemental_subroutine_4.f90: Ditto.
+
2007-09-13 Tobias Burnus <burnus@net-b.de>
* gfortran.dg/recursive_check_3.f90: New.
diff --git a/gcc/testsuite/gfortran.dg/assumed_size_refs_1.f90 b/gcc/testsuite/gfortran.dg/assumed_size_refs_1.f90
index 1590ec5c697c7b2393b01be56907d60b2170837e..1adfd3d5cc7488b0d5ab81174f54658c6b1b51e6 100644
--- a/gcc/testsuite/gfortran.dg/assumed_size_refs_1.f90
+++ b/gcc/testsuite/gfortran.dg/assumed_size_refs_1.f90
@@ -35,7 +35,7 @@ contains
x = fcn (m) ! { dg-error "upper bound in the last dimension" }
m(:, 1:2) = fcn (q)
call sub (m, x) ! { dg-error "upper bound in the last dimension" }
- call sub (m(1:2, 1:2), x) ! { dg-error "Incompatible ranks in elemental subroutine" }
+ call sub (m(1:2, 1:2), x) ! { dg-error "Incompatible ranks in elemental procedure" }
print *, p
call DHSEQR(x)
diff --git a/gcc/testsuite/gfortran.dg/elemental_args_check_1.f90 b/gcc/testsuite/gfortran.dg/elemental_args_check_1.f90
new file mode 100644
index 0000000000000000000000000000000000000000..caf4d177e5c9b674a5a967725d19c40702eeabba
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/elemental_args_check_1.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! PR fortran/33343
+!
+! Check conformance of array actual arguments to
+! elemental function.
+!
+! Contributed by Mikael Morin <mikael.morin@tele2.fr>
+!
+ module geometry
+ implicit none
+ integer, parameter :: prec = 8
+ integer, parameter :: length = 10
+ contains
+ elemental function Mul(a, b)
+ real(kind=prec) :: a
+ real(kind=prec) :: b, Mul
+ intent(in) :: a, b
+ Mul = a * b
+ end function Mul
+
+ pure subroutine calcdAcc2(vectors, angles)
+ real(kind=prec), dimension(:) :: vectors
+ real(kind=prec), dimension(size(vectors),2) :: angles
+ intent(in) :: vectors, angles
+ real(kind=prec), dimension(size(vectors)) :: ax
+ real(kind=prec), dimension(size(vectors),2) :: tmpAcc
+ tmpAcc(1,:) = Mul(angles(1,1:2),ax(1)) ! Ok
+ tmpAcc(:,1) = Mul(angles(:,1),ax) ! OK
+ tmpAcc(:,:) = Mul(angles(:,:),ax) ! { dg-error "Incompatible ranks in elemental procedure" }
+ end subroutine calcdAcc2
+ end module geometry
diff --git a/gcc/testsuite/gfortran.dg/elemental_subroutine_4.f90 b/gcc/testsuite/gfortran.dg/elemental_subroutine_4.f90
index 1a3446264cf42b30d465d88d5be28a3da7225613..1c5b1f7060a1648777888fd2c43fb88f4674cbc8 100644
--- a/gcc/testsuite/gfortran.dg/elemental_subroutine_4.f90
+++ b/gcc/testsuite/gfortran.dg/elemental_subroutine_4.f90
@@ -24,10 +24,10 @@ end module elem_assign
integer :: I(2,2),J(2)
type (mytype) :: w(2,2), x(4), y(5), z(4)
! The original PR
- CALL S(I,J) ! { dg-error "Incompatible ranks in elemental subroutine" }
+ CALL S(I,J) ! { dg-error "Incompatible ranks in elemental procedure" }
! Check interface assignments
- x = w ! { dg-error "Incompatible ranks in elemental subroutine" }
- x = y ! { dg-error "different shape for elemental subroutine" }
+ x = w ! { dg-error "Incompatible ranks in elemental procedure" }
+ x = y ! { dg-error "different shape for elemental procedure" }
x = z
CONTAINS
ELEMENTAL SUBROUTINE S(I,J)