diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 559e688206e..8ec11b6e453 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2013-07-28 Thomas Koenig + + PR fortran/58009 + * expr.c (gfc_check_vardef_context): Check for same values in + vector expression subscripts. + 2013-07-27 Tobias Burnus PR fortran/57991 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 3ece2d3b70c..c00fbc5493f 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -4700,6 +4700,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj, bool unlimited; symbol_attribute attr; gfc_ref* ref; + int i; if (e->expr_type == EXPR_VARIABLE) { @@ -4922,5 +4923,49 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj, } } + /* Check for same value in vector expression subscript. */ + + if (e->rank > 0) + for (ref = e->ref; ref != NULL; ref = ref->next) + if (ref->type == REF_ARRAY && ref->u.ar.type == AR_SECTION) + for (i = 0; i < GFC_MAX_DIMENSIONS + && ref->u.ar.dimen_type[i] != 0; i++) + if (ref->u.ar.dimen_type[i] == DIMEN_VECTOR) + { + gfc_expr *arr = ref->u.ar.start[i]; + if (arr->expr_type == EXPR_ARRAY) + { + gfc_constructor *c, *n; + gfc_expr *ec, *en; + + for (c = gfc_constructor_first (arr->value.constructor); + c != NULL; c = gfc_constructor_next (c)) + { + if (c == NULL || c->iterator != NULL) + continue; + + ec = c->expr; + + for (n = gfc_constructor_next (c); n != NULL; + n = gfc_constructor_next (n)) + { + if (n->iterator != NULL) + continue; + + en = n->expr; + if (gfc_dep_compare_expr (ec, en) == 0) + { + gfc_error_now ("Elements with the same value at %L" + " and %L in vector subscript" + " in a variable definition" + " context (%s)", &(ec->where), + &(en->where), context); + return false; + } + } + } + } + } + return true; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index fe05cb85690..38fcfefd630 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2013-07-28 Thomas Koenig + + PR fortran/58009 + * gfortran.dg/vector_subsript_7.f90: New test. + 2013-07-27 Tobias Burnus PR fortran/57991 diff --git a/gcc/testsuite/gfortran.dg/vector_subscript_7.f90 b/gcc/testsuite/gfortran.dg/vector_subscript_7.f90 new file mode 100644 index 00000000000..ddc813904b7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/vector_subscript_7.f90 @@ -0,0 +1,21 @@ +! { dg-do compile } +! PR 58009 - If a vector subscript has two or more elements with the +! same value, an array section with that vector subscript +! shall not appear in a variable definition context. + +program main + real, dimension(4) :: a,b + real, dimension(1,4) :: c + read (*,*) a([1,2,3,2]),i ! { dg-error "Elements with the same value" } + read (*,*) c(1,[1,2,3,2]),i ! { dg-error "Elements with the same value" } + b([1+i,1,i+1,2]) = a ! { dg-error "Elements with the same value" } + c(1,[1+i,1,i+1,2]) = a ! { dg-error "Elements with the same value" } + call foo (a([4,2,1,1])) ! { dg-error "Elements with the same value" } + call foo (c(1,[4,2,1,1])) ! { dg-error "Elements with the same value" } + print *,a,b +contains + subroutine foo(arg) + real, intent(inout) :: arg(:) + arg = arg + 1 + end subroutine foo +end program main