From 1c54741a0e03064fee403083b2d18336b75ec24b Mon Sep 17 00:00:00 2001 From: "Steven G. Kargl" Date: Tue, 3 Jan 2006 22:01:10 +0000 Subject: [PATCH] re PR fortran/25101 ([4.1] Zero stride allowed in FORALL:s) 2006-01-03 Steven G. Kargl PR fortran/25101 * resolve.c (resolve_forall_iterators): Check for scalar variables; Check stride is nonzero. * gfortran.dg/forall_2.f90: New test. From-SVN: r109288 --- gcc/fortran/ChangeLog | 6 ++++++ gcc/fortran/resolve.c | 31 ++++++++++++++++++++----------- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/forall_2.f90 | 9 +++++++++ 4 files changed, 40 insertions(+), 11 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/forall_2.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e2f63f6..a1aec25 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2006-01-03 Steven G. Kargl + + PR fortran/25101 + * resolve.c (resolve_forall_iterators): Check for scalar variables; + Check stride is nonzero. + 2006-01-02 Steven G. Kargl PR fortran/24640 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 63c9abd..d0b7ab9 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -2509,7 +2509,9 @@ gfc_resolve_iterator (gfc_iterator * iter, bool real_ok) } -/* Resolve a list of FORALL iterators. */ +/* Resolve a list of FORALL iterators. The FORALL index-name is constrained + to be a scalar INTEGER variable. The subscripts and stride are scalar + INTEGERs, and if stride is a constant it must be nonzero. */ static void resolve_forall_iterators (gfc_forall_iterator * iter) @@ -2518,28 +2520,35 @@ resolve_forall_iterators (gfc_forall_iterator * iter) while (iter) { if (gfc_resolve_expr (iter->var) == SUCCESS - && iter->var->ts.type != BT_INTEGER) - gfc_error ("FORALL Iteration variable at %L must be INTEGER", + && (iter->var->ts.type != BT_INTEGER || iter->var->rank != 0)) + gfc_error ("FORALL index-name at %L must be a scalar INTEGER", &iter->var->where); if (gfc_resolve_expr (iter->start) == SUCCESS - && iter->start->ts.type != BT_INTEGER) - gfc_error ("FORALL start expression at %L must be INTEGER", + && (iter->start->ts.type != BT_INTEGER || iter->start->rank != 0)) + gfc_error ("FORALL start expression at %L must be a scalar INTEGER", &iter->start->where); if (iter->var->ts.kind != iter->start->ts.kind) gfc_convert_type (iter->start, &iter->var->ts, 2); if (gfc_resolve_expr (iter->end) == SUCCESS - && iter->end->ts.type != BT_INTEGER) - gfc_error ("FORALL end expression at %L must be INTEGER", + && (iter->end->ts.type != BT_INTEGER || iter->end->rank != 0)) + gfc_error ("FORALL end expression at %L must be a scalar INTEGER", &iter->end->where); if (iter->var->ts.kind != iter->end->ts.kind) gfc_convert_type (iter->end, &iter->var->ts, 2); - if (gfc_resolve_expr (iter->stride) == SUCCESS - && iter->stride->ts.type != BT_INTEGER) - gfc_error ("FORALL Stride expression at %L must be INTEGER", - &iter->stride->where); + if (gfc_resolve_expr (iter->stride) == SUCCESS) + { + if (iter->stride->ts.type != BT_INTEGER || iter->stride->rank != 0) + gfc_error ("FORALL stride expression at %L must be a scalar %s", + &iter->stride->where, "INTEGER"); + + if (iter->stride->expr_type == EXPR_CONSTANT + && mpz_cmp_ui(iter->stride->value.integer, 0) == 0) + gfc_error ("FORALL stride expression at %L cannot be zero", + &iter->stride->where); + } if (iter->var->ts.kind != iter->stride->ts.kind) gfc_convert_type (iter->stride, &iter->var->ts, 2); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 2fbd33a..9d4355c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2006-01-03 Steven G. Kargl + + PR fortran/25101 + * gfortran.dg/forall_2.f90: New test. + 2006-01-03 Hans-Peter Nilsson * g++.dg/abi/thunk3.C, g++.dg/abi/thunk4.C: Gate on diff --git a/gcc/testsuite/gfortran.dg/forall_2.f90 b/gcc/testsuite/gfortran.dg/forall_2.f90 new file mode 100644 index 0000000..223c2ce --- /dev/null +++ b/gcc/testsuite/gfortran.dg/forall_2.f90 @@ -0,0 +1,9 @@ +! { dg-do compile } +! PR fortran/25101 -- Stride must be nonzero. +program forall_2 + integer :: a(10),j(2),i + forall(i=1:2:0) ! { dg-error "stride expression at" } + a(i)=1 + end forall +end program forall_2 + -- 2.7.4