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

5 files changed, 79 insertions, 1 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d478a25..d2470a1 100644
--- 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
--- 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
--- 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
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
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