re PR fortran/30814 (non-conforming array sizes in PACK should raise an error)

2007-07-24  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/30814
	* trans-decl.c (generate_function_code):  Add argument
	for flag_bounds_check to the array for set_options.
	* invoke.texi:  Mention that some checks require
	-fbounds-check to be set during compilation of the
	main program.

2007-07-24  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/30814
	* libgfortran.h:  Add bounds_check to compile_options_t.
	* runtime/compile_options.c (set_options):  Add handling
	of compile_options.bounds_check.
	* intrinsics/pack_generic.c (pack_internal):  Also determine
	the number of elements if compile_options.bounds_check is
	true.  Raise runtime error if a different array shape is
	detected.

2007-07-24  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/30814
	* gfortran.dg/pack_bounds_1.f90:  New test case.

From-SVN: r126866

gcc/fortran/ChangeLog

@@ -1,3 +1,14 @@
+2007-07-24  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/30814
+	* libgfortran.h:  Add bounds_check to compile_options_t.
+	* runtime/compile_options.c (set_options):  Add handling
+	of compile_options.bounds_check.
+	* intrinsics/pack_generic.c (pack_internal):  Also determine
+	the number of elements if compile_options.bounds_check is
+	true.  Raise runtime error if a different array shape is
+	detected.
+
 2007-07-23  Daniel Franke  <franke.daniel@gmail.com>
 
 	PR fortran/25104

gcc/fortran/invoke.texi

@@ -828,6 +828,9 @@ and against the declared minimum and maximum values.  It also
 checks array indices for assumed and deferred
 shape arrays against the actual allocated bounds.
 
+Some checks require that @option{-fbounds-check} is set for
+the compilation of the main probram.
+
 In the future this may also include other forms of checking, e.g., checking
 substring references.
 

gcc/fortran/trans-decl.c

@@ -3191,9 +3191,13 @@ gfc_generate_function_code (gfc_namespace * ns)
 			 build_int_cst (gfc_c_int_type_node,
 					gfc_option.flag_sign_zero), array);
 
+      array = tree_cons (NULL_TREE,
+			 build_int_cst (gfc_c_int_type_node,
+					flag_bounds_check), array);
+
       array_type = build_array_type (gfc_c_int_type_node,
 				     build_index_type (build_int_cst (NULL_TREE,
-								      5)));
+								      6)));
       array = build_constructor_from_list (array_type, nreverse (array));
       TREE_CONSTANT (array) = 1;
       TREE_INVARIANT (array) = 1;
@@ -3209,7 +3213,7 @@ gfc_generate_function_code (gfc_namespace * ns)
       var = gfc_build_addr_expr (pvoid_type_node, var);
 
       tmp = build_call_expr (gfor_fndecl_set_options, 2,
-			     build_int_cst (gfc_c_int_type_node, 6), var);
+			     build_int_cst (gfc_c_int_type_node, 7), var);
       gfc_add_expr_to_block (&body, tmp);
     }
 

gcc/testsuite/ChangeLog

@@ -1,3 +1,8 @@
+2007-07-24  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/30814
+	* gfortran.dg/pack_bounds_1.f90:  New test case.
+
 2007-07-23  Daniel Franke  <franke.daniel@gmail.com>
 
 	PR fortran/31639

gcc/testsuite/gfortran.dg/pack_bounds_1.f90

@@ -0,0 +1,10 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Incorrect extent in return value of  PACK intrinsic" }
+! PR 30814 - a bounds error with pack was not caught.
+program main
+  integer :: a(2,2), b(5)
+  a = reshape((/ 1, -1, 1, -1 /), shape(a))
+  b = pack(a, a /= 0)
+end program main
+! { dg-output "Fortran runtime error: Incorrect extent in return value of PACK intrinsic" }

libgfortran/ChangeLog

@@ -1,3 +1,14 @@
+2007-07-24  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/30814
+	* libgfortran.h:  Add bounds_check to compile_options_t.
+	* runtime/compile_options.c (set_options):  Add handling
+	of compile_options.bounds_check.
+	* intrinsics/pack_generic.c (pack_internal):  Also determine
+	the number of elements if compile_options.bounds_check is
+	true.  Raise runtime error if a different array shape is
+	detected.
+
 2007-07-23  Christopher D. Rickett  <crickett@lanl.gov>
 
 	PR fortran/32600

libgfortran/intrinsics/pack_generic.c

@@ -97,6 +97,7 @@ pack_internal (gfc_array_char *ret, const gfc_array_char *array,
   index_type n;
   index_type dim;
   index_type nelem;
+  index_type total;
 
   dim = GFC_DESCRIPTOR_RANK (array);
   zero_sized = 0;
@@ -127,10 +128,10 @@ pack_internal (gfc_array_char *ret, const gfc_array_char *array,
       mptr = GFOR_POINTER_L8_TO_L4 (mptr);
     }
 
-  if (ret->data == NULL)
+  if (ret->data == NULL || compile_options.bounds_check)
     {
-      /* Allocate the memory for the result.  */
-      int total;
+      /* Count the elements, either for allocating memory or
+	 for bounds checking.  */
 
       if (vector != NULL)
 	{
@@ -196,20 +197,30 @@ pack_internal (gfc_array_char *ret, const gfc_array_char *array,
 	    }
 	}
 
-      /* Setup the array descriptor.  */
-      ret->dim[0].lbound = 0;
-      ret->dim[0].ubound = total - 1;
-      ret->dim[0].stride = 1;
-
-      ret->offset = 0;
-      if (total == 0)
+      if (ret->data == NULL)
 	{
-	  /* In this case, nothing remains to be done.  */
-	  ret->data = internal_malloc_size (1);
-	  return;
+	  /* Setup the array descriptor.  */
+	  ret->dim[0].lbound = 0;
+	  ret->dim[0].ubound = total - 1;
+	  ret->dim[0].stride = 1;
+
+	  ret->offset = 0;
+	  if (total == 0)
+	    {
+	      /* In this case, nothing remains to be done.  */
+	      ret->data = internal_malloc_size (1);
+	      return;
+	    }
+	  else
+	    ret->data = internal_malloc_size (size * total);
+	}
+      else 
+	{
+	  /* We come here because of range checking.  */
+	  if (total != ret->dim[0].ubound + 1 - ret->dim[0].lbound)
+	    runtime_error ("Incorrect extent in return value of"
+			   " PACK intrinsic");
 	}
-      else
-	ret->data = internal_malloc_size (size * total);
     }
 
   rstride0 = ret->dim[0].stride * size;

libgfortran/runtime/compile_options.c

@@ -54,6 +54,8 @@ set_options (int num, int options[])
     compile_options.backtrace = options[4];
   if (num >= 6)
     compile_options.sign_zero = options[5];
+  if (num >= 7)
+    compile_options.bounds_check = options[6];
 }