From 4c7382bba925267cd4c71d29c0255c2964b4cb67 Mon Sep 17 00:00:00 2001 From: Francois-Xavier Coudert Date: Wed, 14 May 2008 21:20:10 +0000 Subject: [PATCH] re PR fortran/35682 (assignment to run-time zero-sized complex section stores a value) PR fortran/35682 * trans-array.c (gfc_conv_ss_startstride): Any negative size is the same as zero size. (gfc_conv_loop_setup): Fix size calculation. * gfortran.dg/bound_4.f90: New test. * gfortran.dg/bounds_check_14.f90: New test. From-SVN: r135306 --- gcc/fortran/ChangeLog | 7 +++++ gcc/fortran/trans-array.c | 6 +++- gcc/testsuite/ChangeLog | 6 ++++ gcc/testsuite/gfortran.dg/bound_4.f90 | 30 ++++++++++++++++++ gcc/testsuite/gfortran.dg/bounds_check_14.f90 | 31 +++++++++++++++++++ 5 files changed, 79 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/bound_4.f90 create mode 100644 gcc/testsuite/gfortran.dg/bounds_check_14.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index d478a2511df..d2470a1edd6 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2008-05-14 Francois-Xavier Coudert + + PR fortran/35682 + * trans-array.c (gfc_conv_ss_startstride): Any negative size is + the same as zero size. + (gfc_conv_loop_setup): Fix size calculation. + 2008-05-14 Francois-Xavier Coudert PR fortran/35685 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 5fc56883bc9..3c099ddcc9d 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -3083,6 +3083,8 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) info->start[n]); tmp = fold_build2 (FLOOR_DIV_EXPR, gfc_array_index_type, tmp, info->stride[n]); + tmp = fold_build2 (MAX_EXPR, gfc_array_index_type, tmp, + build_int_cst (gfc_array_index_type, 0)); /* We remember the size of the first section, and check all the others against this. */ if (size[n]) @@ -3435,8 +3437,10 @@ gfc_conv_loop_setup (gfc_loopinfo * loop) for (i = 0; i<=last; i++){...}; */ tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, loop->to[n], loop->from[n]); - tmp = fold_build2 (TRUNC_DIV_EXPR, gfc_array_index_type, + tmp = fold_build2 (FLOOR_DIV_EXPR, gfc_array_index_type, tmp, info->stride[n]); + tmp = fold_build2 (MAX_EXPR, gfc_array_index_type, tmp, + build_int_cst (gfc_array_index_type, -1)); loop->to[n] = gfc_evaluate_now (tmp, &loop->pre); /* Make the loop variable start at 0. */ loop->from[n] = gfc_index_zero_node; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index f2795bb9c1f..2fa16223fab 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2008-05-14 Francois-Xavier Coudert + + PR fortran/35682 + * gfortran.dg/bound_4.f90: New test. + * gfortran.dg/bounds_check_14.f90: New test. + 2008-05-14 Francois-Xavier Coudert PR fortran/35685 diff --git a/gcc/testsuite/gfortran.dg/bound_4.f90 b/gcc/testsuite/gfortran.dg/bound_4.f90 new file mode 100644 index 00000000000..dd934519d53 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/bound_4.f90 @@ -0,0 +1,30 @@ +! { dg-do run } + +program test + integer x(20) + integer, volatile :: n + n = 1 + if (size(x(n:2:-3)) /= 0) call abort + + call ha0020(-3) + call ha0020(-1) +end program test + +subroutine ha0020(mf3) + implicit none + integer xca(1), xda(1), mf3 + + xca = 1 + xda = -1 + + xca(1:1) = xda(1:2:mf3) + + if (any (xca /= -1)) call abort + if (any(xda(1:2:mf3) /= xda(1:0))) call abort + if (size(xda(1:2:mf3)) /= 0) call abort + if (any(shape(xda(1:2:mf3)) /= 0)) call abort + if (any(ubound(xda(1:2:mf3)) /= 0)) call abort + if (ubound(xda(1:2:mf3),1) /= 0) call abort + if (lbound(xda(1:2:mf3),1) /= 1) call abort + +end subroutine diff --git a/gcc/testsuite/gfortran.dg/bounds_check_14.f90 b/gcc/testsuite/gfortran.dg/bounds_check_14.f90 new file mode 100644 index 00000000000..0b7edfe565b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/bounds_check_14.f90 @@ -0,0 +1,31 @@ +! { dg-do run } +! { dg-options "-fbounds-check" } + +program test + integer x(20) + integer, volatile :: n + n = 1 + if (size(x(n:2:-3)) /= 0) call abort + + call ha0020(-3) + call ha0020(-1) +end program test + +subroutine ha0020(mf3) + implicit none + integer xca(1), xda(1), mf3 + + xca = 1 + xda = -1 + + xca(1:1) = xda(1:2:mf3) + + if (any (xca /= -1)) call abort + if (any(xda(1:2:mf3) /= xda(1:0))) call abort + if (size(xda(1:2:mf3)) /= 0) call abort + if (any(shape(xda(1:2:mf3)) /= 0)) call abort + if (any(ubound(xda(1:2:mf3)) /= 0)) call abort + if (ubound(xda(1:2:mf3),1) /= 0) call abort + if (lbound(xda(1:2:mf3),1) /= 1) call abort + +end subroutine -- 2.30.2