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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d478a25..d2470a1 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,12 @@
 2008-05-14  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
+       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  <fxcoudert@gcc.gnu.org>
+
        PR fortran/35685
        * trans-intrinsic.c (gfc_conv_intrinsic_bound): Correctly
        handle zero-size sections.

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 5fc5688..3c099dd 100644 (file)
--- 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 f2795bb..2fa1622 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,11 @@
 2008-05-14  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
+       PR fortran/35682
+       * gfortran.dg/bound_4.f90: New test.
+       * gfortran.dg/bounds_check_14.f90: New test.
+
+2008-05-14  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
        PR fortran/35685
        * gfortran.dg/bound_3.f90: New test.
 

diff --git a/gcc/testsuite/gfortran.dg/bound_4.f90 b/gcc/testsuite/gfortran.dg/bound_4.f90
new file mode 100644 (file)
index 0000000..dd93451
--- /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 (file)
index 0000000..0b7edfe
--- /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