This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[patch, fortran] Fix PR 30814, bounds checking for pack
- From: Thomas Koenig <tkoenig at alice-dsl dot net>
- To: fortran at gcc dot gnu dot org
- Cc: gcc-patches at gcc dot gnu dot org
- Date: Fri, 20 Jul 2007 00:01:29 +0200
- Subject: [patch, fortran] Fix PR 30814, bounds checking for pack
Hello world,
the attached patch introduces bounds checking for pack.
As this operation is potentially expensive, it is only done
if -fbounds-check is passed in compilation to the main
program. The changes for this are also included in the
patch.
As a future project, we could also make other intrinsics
aware of bounds-checking.
The test case passes; otherwise, the patch is currently
regression-testing on i686-pc-linux-gnu.
OK for trunk if it passes?
Thomas
2007-07-20 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.
2007-07-20 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-20 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/30814
* gfortran.dg/pack_bounds_1.f90: New test case.
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c (revision 126729)
+++ gcc/fortran/trans-decl.c (working copy)
@@ -3178,9 +3178,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;
@@ -3196,7 +3200,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: libgfortran/runtime/compile_options.c
===================================================================
--- libgfortran/runtime/compile_options.c (revision 126729)
+++ 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 126729)
+++ 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 ("Different array shape in return value of"
+ " PACK intrinsic");
}
- else
- ret->data = internal_malloc_size (size * total);
}
rstride0 = ret->dim[0].stride * size;
Index: libgfortran/libgfortran.h
===================================================================
--- libgfortran/libgfortran.h (revision 126729)
+++ libgfortran/libgfortran.h (working copy)
@@ -385,6 +385,7 @@ typedef struct
int sign_zero;
size_t record_marker;
int max_subrecord_length;
+ int bounds_check;
}
compile_options_t;