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

gcc/fortran/ChangeLog

+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

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 */

gcc/testsuite/ChangeLog

+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,

gcc/testsuite/gfortran.dg/where_operator_assign_4.f90

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