Re: [patch, fortran] Fix PR 30814, bounds checking for pack

[Thomas Koenig <tkoenig at alice-dsl dot net>]

Hello world,

here's what I committed (revision 126866).

	Thomas

Index: libgfortran/ChangeLog
===================================================================
--- libgfortran/ChangeLog	(revision 126865)
+++ libgfortran/ChangeLog	(working copy)
@@ -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
Index: libgfortran/runtime/compile_options.c
===================================================================
--- libgfortran/runtime/compile_options.c	(revision 126857)
+++ libgfortran/runtime/compile_options.c	(working copy)
@@ -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];
 }
 
 
Index: libgfortran/intrinsics/pack_generic.c
===================================================================
--- libgfortran/intrinsics/pack_generic.c	(revision 126857)
+++ libgfortran/intrinsics/pack_generic.c	(working copy)
@@ -97,6 +97,7 @@ pack_internal (gfc_array_char *ret, cons
   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, cons
       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, cons
 	    }
 	}
 
-      /* 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;
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c	(revision 126857)
+++ gcc/fortran/trans-decl.c	(working copy)
@@ -3191,9 +3191,13 @@ gfc_generate_function_code (gfc_namespac
 			 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_namespac
       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);
     }
 
Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog	(revision 126865)
+++ gcc/fortran/ChangeLog	(working copy)
@@ -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
Index: gcc/fortran/invoke.texi
===================================================================
--- gcc/fortran/invoke.texi	(revision 126857)
+++ gcc/fortran/invoke.texi	(working copy)
@@ -828,6 +828,9 @@ and against the declared minimum and max
 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.
 
Index: gcc/testsuite/gfortran.dg/pack_bounds_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pack_bounds_1.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/pack_bounds_1.f90	(revision 0)
@@ -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" }
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog	(revision 126865)
+++ gcc/testsuite/ChangeLog	(working copy)
@@ -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