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

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 73dcbf87d8e94c2a058ec12e256b9ec5b782b25a..04844601fe13acd2dcdea96ea92bc5d44a85e895 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
index 0000000..caf4d17
--- /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 (file)
--- 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)