From b27eea4839b750651a0d26fbd384cbb53d74914c Mon Sep 17 00:00:00 2001 From: Daniel Franke Date: Mon, 4 Feb 2008 15:37:12 -0500 Subject: [PATCH] backport: re PR fortran/34661 (ice on where / ASSIGNMENT(=)) gcc/fortran: 2008-02-04 Daniel Franke Backport from trunk: 2008-01-25 Daniel Franke 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 PR fortran/34661 * gfortran.dg/where_operator_assign_4.f90: New test. From-SVN: r132094 --- gcc/fortran/ChangeLog | 8 +++++ gcc/fortran/resolve.c | 9 ++++-- gcc/testsuite/ChangeLog | 5 ++++ .../gfortran.dg/where_operator_assign_4.f90 | 30 +++++++++++++++++++ 4 files changed, 49 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/where_operator_assign_4.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index c7bdccf86a8a..1267304d96bf 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2008-02-04 Daniel Franke + + Backport from trunk: + 2008-01-25 Daniel Franke + 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. diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 535a262d9fe2..29c461e7665a 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -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: diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 37438629bf7f..6e1138acd48f 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2008-02-04 Daniel Franke + + PR fortran/34661 + * gfortran.dg/where_operator_assign_4.f90: New test. + 2008-02-04 Andreas Krebbel * gcc.dg/tf_to_di-1.c: New testcase. 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 index 000000000000..4cf14b267315 --- /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 -- 2.47.2