re PR fortran/34661 (ice on where / ASSIGNMENT(=))

gcc/fortran:
2008-01-25  Daniel Franke  <franke.daniel@gmail.com>

        PR fortran/34661
        * resolve.c (resolve_where): Added check if user-defined assignment
        operator is an elemental subroutine.
        (gfc_resolve_where_code_in_forall): Likewise.

gcc/testsuite:
2008-01-25  Daniel Franke  <franke.daniel@gmail.com>

        PR fortran/34661
        * gfortran.dg/where_operator_assign_4.f90: New test.

From-SVN: r131845

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 8d705f8e97f9683a9349a2da80f7015890d4ae5c..6860244a8187d414769540d3124dcac7db171fc2 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2008-01-25  Daniel Franke  <franke.daniel@gmail.com>
+
+       PR fortran/34661
+       * resolve.c (resolve_where): Added check if user-defined assignment 
+       operator is an elemental subroutine.
+       (gfc_resolve_where_code_in_forall): Likewise.
+
 2008-01-24  Daniel Franke  <franke.daniel@gmail.com>
 
        PR fortran/33375

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 38f8e647422fc6496bdb3b370a75c416084b84d0..833fd27611c5f9e3f3a8d6f73fcd8de87be14805 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -5656,6 +5656,9 @@ resolve_where (gfc_code *code, gfc_expr *mask)
   
            case EXEC_ASSIGN_CALL:
              resolve_call (cnext);
+             if (!cnext->resolved_sym->attr.elemental)
+               gfc_error("Non-ELEMETAL user-defined assignment in WHERE at %L",
+                         &cnext->ext.actual->expr->where);
              break;
 
            /* WHERE or WHERE construct is part of a where-body-construct */
@@ -5738,6 +5741,9 @@ gfc_resolve_where_code_in_forall (gfc_code *code, int nvar,
            /* WHERE operator assignment statement */
            case EXEC_ASSIGN_CALL:
              resolve_call (cnext);
+             if (!cnext->resolved_sym->attr.elemental)
+               gfc_error("Non-ELEMETAL user-defined assignment in WHERE at %L",
+                         &cnext->ext.actual->expr->where);
              break;
 
            /* WHERE or WHERE construct is part of a where-body-construct */

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 9c7af4ee89dc4db5bd538f36e004eef9ffe7af4b..0ea511952dce7be9c391811ced636e2a49661810 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2008-01-25  Daniel Franke  <franke.daniel@gmail.com>
+
+       PR fortran/34661
+       * gfortran.dg/where_operator_assign_4.f90: New test.
+
 2008-01-25  Joseph Myers  <joseph@codesourcery.com>
 
        * gcc.dg/builtin-inf-1.c, gcc.dg/compare6.c, gcc.dg/sibcall-3.c,

diff --git a/gcc/testsuite/gfortran.dg/where_operator_assign_4.f90 b/gcc/testsuite/gfortran.dg/where_operator_assign_4.f90
new file mode 100644 (file)
index 0000000..4cf14b2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/where_operator_assign_4.f90
@@ -0,0 +1,30 @@
+! { dg-do compile }
+! PR fortran/34661 ICE on user-defined assignments in where statements
+! Testcase contributed by Joost VandeVondele
+
+MODULE M1
+ IMPLICIT NONE
+ TYPE T1
+   INTEGER :: I
+ END TYPE T1
+ INTERFACE ASSIGNMENT(=)
+  MODULE PROCEDURE S1
+ END INTERFACE
+CONTAINS
+ SUBROUTINE S1(I,J)
+   TYPE(T1), INTENT(OUT)  :: I(2)
+   TYPE(T1), INTENT(IN)  :: J(2)
+   I%I=-J%I
+ END SUBROUTINE S1
+END MODULE M1
+
+USE M1
+TYPE(T1) :: I(2),J(2)
+I(:)%I=1
+WHERE (I(:)%I>0)
+ J=I                       ! { dg-error "Non-ELEMETAL user-defined assignment in WHERE" }
+END WHERE
+
+WHERE (I(:)%I>0) J=I       ! { dg-error "Non-ELEMETAL user-defined assignment in WHERE" }
+
+END