re PR fortran/33343 (ICE (segfault) on invalid code with wrongly shaped…

re PR fortran/33343 (ICE (segfault) on invalid code with wrongly shaped arguments to elemental procedures)

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>

	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.

From-SVN: r128473

gcc/fortran/ChangeLog

 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):
 	Allow prefixes only to be specified once.
 

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));

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;
 	}

gcc/testsuite/ChangeLog

 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.
 
 2007-09-13  Tobias Burnus  <burnus@net-b.de>

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)

gcc/testsuite/gfortran.dg/elemental_args_check_1.f90

+! { 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

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)