From 18fe404fbc9a86d21bcb6d0f02cf2a1d4448d705 Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Tue, 24 Jul 2007 05:52:44 +0000 Subject: [PATCH] re PR fortran/30814 (non-conforming array sizes in PACK should raise an error) 2007-07-24 Thomas Koenig 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 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 PR fortran/30814 * gfortran.dg/pack_bounds_1.f90: New test case. From-SVN: r126866 --- gcc/fortran/ChangeLog | 11 ++++++++ gcc/fortran/invoke.texi | 3 +++ gcc/fortran/trans-decl.c | 8 ++++-- gcc/testsuite/ChangeLog | 5 ++++ gcc/testsuite/gfortran.dg/pack_bounds_1.f90 | 10 ++++++++ libgfortran/ChangeLog | 11 ++++++++ libgfortran/intrinsics/pack_generic.c | 39 ++++++++++++++++++----------- libgfortran/runtime/compile_options.c | 2 ++ 8 files changed, 73 insertions(+), 16 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/pack_bounds_1.f90 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 + + 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 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 + + PR fortran/30814 + * gfortran.dg/pack_bounds_1.f90: New test case. + 2007-07-23  Daniel Franke   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 + + 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 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]; } -- 2.7.4