diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 28fa7ca892d..e3bacc1aa0f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2009-03-28 Tobias Burnus + + PR fortran/38432 + * resolve.c (gfc_resolve_iterator): Add zero-loop warning. + 2009-03-28 Francois-Xavier Coudert Paul Thomas Tobias Burnus diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index e887fb13a6f..1d6ee852426 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -4918,6 +4918,26 @@ gfc_resolve_iterator (gfc_iterator *iter, bool real_ok) || iter->step->ts.type != iter->var->ts.type) gfc_convert_type (iter->step, &iter->var->ts, 2); + if (iter->start->expr_type == EXPR_CONSTANT + && iter->end->expr_type == EXPR_CONSTANT + && iter->step->expr_type == EXPR_CONSTANT) + { + int sgn, cmp; + if (iter->start->ts.type == BT_INTEGER) + { + sgn = mpz_cmp_ui (iter->step->value.integer, 0); + cmp = mpz_cmp (iter->end->value.integer, iter->start->value.integer); + } + else + { + sgn = mpfr_sgn (iter->step->value.real); + cmp = mpfr_cmp (iter->end->value.real, iter->start->value.real); + } + if ((sgn > 0 && cmp < 0) || (sgn < 0 && cmp > 0)) + gfc_warning ("DO loop at %L will be executed zero times", + &iter->step->where); + } + return SUCCESS; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index a2e329e1de3..315f6cfc06f 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,13 @@ +2009-03-28 Tobias Burnus + + PR fortran/38432 + * gfortran.dg/do_check_5.f90: New test. + * gfortran.dg/array_constructor_11.f90: Add dg-warning. + * gfortran.dg/array_constructor_18.f90: Ditto. + * gfortran.dg/array_constructor_22.f90: Ditto. + * gfortran.dg/do_3.F90: Ditto. + * gfortran.dg/do_1.f90: Ditto. + 2009-03-28 Richard Guenther PR tree-optimization/38180 diff --git a/gcc/testsuite/gfortran.dg/array_constructor_11.f90 b/gcc/testsuite/gfortran.dg/array_constructor_11.f90 index 395d2927b9e..bb9f0dddb11 100644 --- a/gcc/testsuite/gfortran.dg/array_constructor_11.f90 +++ b/gcc/testsuite/gfortran.dg/array_constructor_11.f90 @@ -10,20 +10,20 @@ contains call test (1, 11, 3, (/ (i, i = 1, 11, 3) /)) call test (3, 20, 2, (/ (i, i = 3, 20, 2) /)) - call test (4, 0, 11, (/ (i, i = 4, 0, 11) /)) + call test (4, 0, 11, (/ (i, i = 4, 0, 11) /)) ! { dg-warning "will be executed zero times" } call test (110, 10, -3, (/ (i, i = 110, 10, -3) /)) call test (200, 20, -12, (/ (i, i = 200, 20, -12) /)) - call test (29, 30, -6, (/ (i, i = 29, 30, -6) /)) + call test (29, 30, -6, (/ (i, i = 29, 30, -6) /)) ! { dg-warning "will be executed zero times" } call test (1, order, 3, (/ (i, i = 1, order, 3) /)) call test (order, 1, -3, (/ (i, i = order, 1, -3) /)) ! Triggers compile-time iterator calculations in trans-array.c call test (1, 1000, 2, (/ (i, i = 1, 1000, 2), (i, i = order, 0, 1) /)) - call test (1, 0, 3, (/ (i, i = 1, 0, 3), (i, i = order, 0, 1) /)) - call test (1, 2000, -5, (/ (i, i = 1, 2000, -5), (i, i = order, 0, 1) /)) - call test (3000, 99, 4, (/ (i, i = 3000, 99, 4), (i, i = order, 0, 1) /)) + call test (1, 0, 3, (/ (i, i = 1, 0, 3), (i, i = order, 0, 1) /)) ! { dg-warning "will be executed zero times" } + call test (1, 2000, -5, (/ (i, i = 1, 2000, -5), (i, i = order, 0, 1) /)) ! { dg-warning "will be executed zero times" } + call test (3000, 99, 4, (/ (i, i = 3000, 99, 4), (i, i = order, 0, 1) /)) ! { dg-warning "will be executed zero times" } call test (400, 77, -39, (/ (i, i = 400, 77, -39), (i, i = order, 0, 1) /)) do j = -10, 10 diff --git a/gcc/testsuite/gfortran.dg/array_constructor_18.f90 b/gcc/testsuite/gfortran.dg/array_constructor_18.f90 index 246f448063c..c78976839d0 100644 --- a/gcc/testsuite/gfortran.dg/array_constructor_18.f90 +++ b/gcc/testsuite/gfortran.dg/array_constructor_18.f90 @@ -5,7 +5,7 @@ ! ! Contributed by Joost VandeVondele ! - call foo ((/(S1(i),i=1,3,-1)/)) + call foo ((/(S1(i),i=1,3,-1)/)) ! { dg-warning "will be executed zero times" } CONTAINS FUNCTION S1(i) CHARACTER(LEN=1) :: S1 diff --git a/gcc/testsuite/gfortran.dg/array_constructor_22.f90 b/gcc/testsuite/gfortran.dg/array_constructor_22.f90 index d29039a80e6..0dcdaea68c1 100644 --- a/gcc/testsuite/gfortran.dg/array_constructor_22.f90 +++ b/gcc/testsuite/gfortran.dg/array_constructor_22.f90 @@ -7,7 +7,7 @@ module test function my_string(x) integer i real, intent(in) :: x(:) - character(0) h4(1:minval([(1,i=1,0)],1)) + character(0) h4(1:minval([(1,i=1,0)],1)) ! { dg-warning "will be executed zero times" } character(0) sv1(size(x,1):size(h4)) character(0) sv2(2*lbound(sv1,1):size(h4)) character(lbound(sv2,1)-3) my_string diff --git a/gcc/testsuite/gfortran.dg/do_1.f90 b/gcc/testsuite/gfortran.dg/do_1.f90 index 20e1f31ca67..171275af3f2 100644 --- a/gcc/testsuite/gfortran.dg/do_1.f90 +++ b/gcc/testsuite/gfortran.dg/do_1.f90 @@ -29,17 +29,17 @@ program do_1 ! Zero iterations j = 0 - do i = 1, 0, 1 + do i = 1, 0, 1 ! { dg-warning "executed zero times" } j = j + 1 end do if (j .ne. 0) call abort j = 0 - do i = 1, 0, 2 + do i = 1, 0, 2 ! { dg-warning "executed zero times" } j = j + 1 end do if (j .ne. 0) call abort j = 0 - do i = 1, 2, -1 + do i = 1, 2, -1 ! { dg-warning "executed zero times" } j = j + 1 end do if (j .ne. 0) call abort diff --git a/gcc/testsuite/gfortran.dg/do_3.F90 b/gcc/testsuite/gfortran.dg/do_3.F90 index 3cada5a0051..67723a508f4 100644 --- a/gcc/testsuite/gfortran.dg/do_3.F90 +++ b/gcc/testsuite/gfortran.dg/do_3.F90 @@ -21,16 +21,16 @@ program test TEST_LOOP(i, 0, 1, 2, 1, test_i, 2) TEST_LOOP(i, 0, 1, 3, 1, test_i, 3) TEST_LOOP(i, 0, 1, huge(0), 1, test_i, huge(0)) - TEST_LOOP(i, 0, 1, -1, 0, test_i, 0) - TEST_LOOP(i, 0, 1, -2, 0, test_i, 0) - TEST_LOOP(i, 0, 1, -3, 0, test_i, 0) - TEST_LOOP(i, 0, 1, -huge(0), 0, test_i, 0) - TEST_LOOP(i, 0, 1, -huge(0)-1, 0, test_i, 0) + TEST_LOOP(i, 0, 1, -1, 0, test_i, 0) ! { dg-warning "executed zero times" } + TEST_LOOP(i, 0, 1, -2, 0, test_i, 0) ! { dg-warning "executed zero times" } + TEST_LOOP(i, 0, 1, -3, 0, test_i, 0) ! { dg-warning "executed zero times" } + TEST_LOOP(i, 0, 1, -huge(0), 0, test_i, 0) ! { dg-warning "executed zero times" } + TEST_LOOP(i, 0, 1, -huge(0)-1, 0, test_i, 0) ! { dg-warning "executed zero times" } - TEST_LOOP(i, 1, 0, 1, 0, test_i, 1) - TEST_LOOP(i, 1, 0, 2, 0, test_i, 1) - TEST_LOOP(i, 1, 0, 3, 0, test_i, 1) - TEST_LOOP(i, 1, 0, huge(0), 0, test_i, 1) + TEST_LOOP(i, 1, 0, 1, 0, test_i, 1) ! { dg-warning "executed zero times" } + TEST_LOOP(i, 1, 0, 2, 0, test_i, 1) ! { dg-warning "executed zero times" } + TEST_LOOP(i, 1, 0, 3, 0, test_i, 1) ! { dg-warning "executed zero times" } + TEST_LOOP(i, 1, 0, huge(0), 0, test_i, 1) ! { dg-warning "executed zero times" } TEST_LOOP(i, 1, 0, -1, 2, test_i, -1) TEST_LOOP(i, 1, 0, -2, 1, test_i, -1) TEST_LOOP(i, 1, 0, -3, 1, test_i, -2) @@ -58,14 +58,14 @@ program test TEST_LOOP(i1, huge(i1), -huge(i1)-1_1, -huge(i1)-1_1, 2, test_i1, -huge(i1)-2_1) TEST_LOOP(i1, -2_1, 3_1, huge(i1), 1, test_i1, huge(i1)-2_1) - TEST_LOOP(i1, -2_1, 3_1, -huge(i1), 0, test_i1, -2_1) + TEST_LOOP(i1, -2_1, 3_1, -huge(i1), 0, test_i1, -2_1) ! { dg-warning "executed zero times" } TEST_LOOP(i1, 2_1, -3_1, -huge(i1), 1, test_i1, 2_1-huge(i1)) - TEST_LOOP(i1, 2_1, -3_1, huge(i1), 0, test_i1, 2_1) + TEST_LOOP(i1, 2_1, -3_1, huge(i1), 0, test_i1, 2_1) ! { dg-warning "executed zero times" } ! Real loops TEST_LOOP(r, 0.0, 1.0, 0.11, 1 + int(1.0/0.11), test_r, 0.0) - TEST_LOOP(r, 0.0, 1.0, -0.11, 0, test_r, 0.0) - TEST_LOOP(r, 0.0, -1.0, 0.11, 0, test_r, 0.0) + TEST_LOOP(r, 0.0, 1.0, -0.11, 0, test_r, 0.0) ! { dg-warning "executed zero times" } + TEST_LOOP(r, 0.0, -1.0, 0.11, 0, test_r, 0.0) ! { dg-warning "executed zero times" } TEST_LOOP(r, 0.0, -1.0, -0.11, 1 + int(1.0/0.11), test_r, 0.0) TEST_LOOP(r, 0.0, 0.0, 0.11, 1, test_r, 0.0) TEST_LOOP(r, 0.0, 0.0, -0.11, 1, test_r, 0.0) diff --git a/gcc/testsuite/gfortran.dg/do_check_5.f90 b/gcc/testsuite/gfortran.dg/do_check_5.f90 new file mode 100644 index 00000000000..081a228cfc7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/do_check_5.f90 @@ -0,0 +1,32 @@ +! { dg-do compile } +! +! PR/fortran 38432 +! DO-loop compile-time checks +! +implicit none +integer :: i +real :: r +do i = 1, 0 ! { dg-warning "executed zero times" } +end do + +do i = 1, -1, 1 ! { dg-warning "executed zero times" } +end do + +do i = 1, 2, -1 ! { dg-warning "executed zero times" } +end do + +do i = 1, 2, 0 ! { dg-error "cannot be zero" } +end do + +do r = 1, 0 ! { dg-warning "must be integer|executed zero times" } +end do + +do r = 1, -1, 1 ! { dg-warning "must be integer|executed zero times" } +end do + +do r = 1, 2, -1 ! { dg-warning "must be integer|executed zero times" } +end do + +do r = 1, 2, 0 ! { dg-error "must be integer|cannot be zero" } +end do +end