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

8 files changed, 73 insertions, 16 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index b896f98..745343e 100644
--- a/gcc/fortran/ChangeLog
+++ b/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
diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
index 2e47391..fb0aa87 100644
--- a/gcc/fortran/invoke.texi
+++ b/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.
 
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 0acd5f8..1fd4373 100644
--- a/gcc/fortran/trans-decl.c
+++ b/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);
     }
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index ce6a359..39a1404 100644
--- a/gcc/testsuite/ChangeLog
+++ b/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
diff --git a/gcc/testsuite/gfortran.dg/pack_bounds_1.f90 b/gcc/testsuite/gfortran.dg/pack_bounds_1.f90
new file mode 100644
index 0000000..94c8eb0
--- /dev/null
+++ b/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" }
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index ae9d6b0..658d702 100644
--- a/libgfortran/ChangeLog
+++ b/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
diff --git a/libgfortran/intrinsics/pack_generic.c b/libgfortran/intrinsics/pack_generic.c
index 06e7084..104c59f 100644
--- a/libgfortran/intrinsics/pack_generic.c
+++ b/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;
+      if (ret->data == NULL)
+	{
+	  /* 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)
+	  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 
 	{
-	  /* In this case, nothing remains to be done.  */
-	  ret->data = internal_malloc_size (1);
-	  return;
+	  /* 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;
diff --git a/libgfortran/runtime/compile_options.c b/libgfortran/runtime/compile_options.c
index 0976a39..a6e2a42 100644
--- a/libgfortran/runtime/compile_options.c
+++ b/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];
 }