[multiple changes]

2006-10-17  Paul Thomas <pault@gcc.gnu.org>

	PR fortran/20541
	* trans-array.c (gfc_trans_array_bounds): Test for and set
	negative stride of a non-constant bound array to zero.

	PR fortran/29392
	* data.c (create_character_intializer): Copy and simplify
	the expressions for the start and end of a sub-string
	reference.

2006-10-17  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/29392
	* gfortran.dg/data_char_3.f90: New test.

	PR fortran/20541
	* gfortran.dg/negative_automatic_size.f90: New test.

From-SVN: r117797

gcc/fortran/ChangeLog

@@ -1,3 +1,14 @@
+2006-10-17  Paul Thomas <pault@gcc.gnu.org>
+
+	PR fortran/20541
+	* trans-array.c (gfc_trans_array_bounds): Test for and set
+	negative stride of a non-constant bound array to zero.
+
+	PR fortran/29392
+	* data.c (create_character_intializer): Copy and simplify
+	the expressions for the start and end of a sub-string
+	reference.
+
 2006-10-16  Kaz Kojima  <kkojima@rr.iij4u.or.jp>
 
 	* io.c (gfc_match_close): Ensure that status is terminated by

gcc/fortran/data.c

@@ -167,13 +167,26 @@ create_character_intializer (gfc_expr * init, gfc_typespec * ts,
 
   if (ref)
     {
+      gfc_expr *start_expr, *end_expr;
+
       gcc_assert (ref->type == REF_SUBSTRING);
 
       /* Only set a substring of the destination.  Fortran substring bounds
          are one-based [start, end], we want zero based [start, end).  */
-      gfc_extract_int (ref->u.ss.start, &start);
+      start_expr = gfc_copy_expr (ref->u.ss.start);
+      end_expr = gfc_copy_expr (ref->u.ss.end);
+
+      if ((gfc_simplify_expr (start_expr, 1) == FAILURE)
+	     || (gfc_simplify_expr (end_expr, 1)) == FAILURE)
+	{
+	  gfc_error ("failure to simplify substring reference in DATA"
+		     "statement at %L", &ref->u.ss.start->where);
+	  return NULL;
+	}
+
+      gfc_extract_int (start_expr, &start);
       start--;
-      gfc_extract_int (ref->u.ss.end, &end);
+      gfc_extract_int (end_expr, &end);
     }
   else
     {

gcc/fortran/trans-array.c

@@ -3540,6 +3540,14 @@ gfc_trans_array_bounds (tree type, gfc_symbol * sym, tree * poffset,
             gfc_add_modify_expr (pblock, stride, tmp);
           else
             stride = gfc_evaluate_now (tmp, pblock);
+
+	  /* Make sure that negative size arrays are translated
+	     to being zero size.  */
+	  tmp = build2 (GE_EXPR, boolean_type_node,
+			stride, gfc_index_zero_node);
+	  tmp = build3 (COND_EXPR, gfc_array_index_type, tmp,
+			stride, gfc_index_zero_node);
+	  gfc_add_modify_expr (pblock, stride, tmp);
         }
 
       size = stride;

gcc/testsuite/ChangeLog

@@ -1,3 +1,11 @@
+2006-10-17  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/29392
+	* gfortran.dg/data_char_3.f90: New test.
+
+	PR fortran/20541
+	* gfortran.dg/negative_automatic_size.f90: New test.
+
 2006-10-16  David Daney  <ddaney@avtrex.com>
 
 	* g++.dg/other/unused1.C : Match on '.ascii\t"name\000"' also.

gcc/testsuite/gfortran.dg/data_char_3.f90

@@ -0,0 +1,11 @@
+! { dg-do run }
+! { dg-options "-O2" }
+! Tests the fix PR29392, in which the iterator valued substring
+! reference would cause a segfault.
+!
+! Contributed by Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>   
+!
+  character(LEN=2) :: a(2) 
+  data ((a(I)(k:k),I=1,2),k=1,2) /2*'a',2*'z'/ 
+  IF (ANY(a.NE."az")) CALL ABORT() 
+  END 

gcc/testsuite/gfortran.dg/negative_automatic_size.f90

@@ -0,0 +1,29 @@
+! { dg-do run }
+! { dg-options "-O2" }
+! Tests the fix PR29451, in which the negative size of the
+! automatic array 'jello' was not detected and the
+! runtime error: Attempt to allocate a negative amount of memory
+! resulted.
+!
+! Contributed by Philip Mason  <pmason@ricardo.com> 
+!
+program fred
+  call jackal (1, 0)
+  call jackal (2, 1)
+  call jackal (3, 0)
+end
+
+subroutine jackal (b, c)
+  integer :: b, c
+  integer :: jello(b:c), cake(1:2, b:c), soda(b:c, 1:2)
+  if (lbound (jello, 1) <= ubound (jello, 1)) call abort ()
+  if (size (jello) /= 0) call abort ()
+
+  if (.not.any(lbound (cake) <= ubound (cake))) call abort ()
+  if (size (cake) /= 0) call abort ()
+
+  if ((lbound (soda, 1) > ubound (soda, 1)) .and. &
+      (lbound (soda, 2) > ubound (soda, 2))) call abort ()
+  if (size (soda) /= 0) call abort ()
+
+end subroutine jackal