This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[patch, fortran, committed] PR34661 - backport to 4.2
- From: Daniel Franke <franke dot daniel at gmail dot com>
- To: fortran at gcc dot gnu dot org, gcc-patches at gcc dot gnu dot org
- Date: Mon, 4 Feb 2008 21:37:41 +0100
- Subject: [patch, fortran, committed] PR34661 - backport to 4.2
Attached patch was backported and applied to 4.2.
Bootstrapped and regression tested on i686-pc-linux-gnu.
gcc/fortran:
2008-02-04 Daniel Franke <franke.daniel@gmail.com>
Backport from trunk:
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.
gcc/testsuite:
2008-02-04 Daniel Franke <franke.daniel@gmail.com>
PR fortran/34661
* gfortran.dg/where_operator_assign_4.f90: New test.
Regards
Daniel
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (revision 132093)
+++ gcc/fortran/resolve.c (working copy)
@@ -4568,9 +4568,12 @@ resolve_where (gfc_code *code, gfc_expr
"inconsistent shape", &cnext->expr->where);
break;
- case EXEC_ASSIGN_CALL:
- resolve_call (cnext);
- break;
+ 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 */
case EXEC_WHERE:
Index: gcc/testsuite/gfortran.dg/where_operator_assign_4.f90
===================================================================
--- gcc/testsuite/gfortran.dg/where_operator_assign_4.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/where_operator_assign_4.f90 (revision 0)
@@ -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