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

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.

From-SVN: r132094
This commit is contained in:
Daniel Franke
2008-02-04 15:37:12 -05:00
committed by Daniel Franke
parent 944cf28731
commit b27eea4839
4 changed files with 49 additions and 3 deletions

View File

@@ -1,3 +1,11 @@
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.
2008-02-01 Release Manager
* GCC 4.2.3 released.

View File

@@ -4568,9 +4568,12 @@ resolve_where (gfc_code *code, gfc_expr *mask)
"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:

View File

@@ -1,3 +1,8 @@
2008-02-04 Daniel Franke <franke.daniel@gmail.com>
PR fortran/34661
* gfortran.dg/where_operator_assign_4.f90: New test.
2008-02-04 Andreas Krebbel <krebbel1@de.ibm.com>
* gcc.dg/tf_to_di-1.c: New testcase.

View File

@@ -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