From 18d95bdf87080e1574aa2758ba9b977033ef84ee Mon Sep 17 00:00:00 2001 From: Jan Kratochvil Date: Sat, 15 Jan 2011 21:17:58 +0100 Subject: [PATCH] - [vla] Support Fortran vector slices and subsets (BZ 609782). --- gdb-archer-vla-misc.patch | 241 ++++++++++++++++ gdb-archer-vla-subarray.patch | 504 ++++++++++++++++++++++++++++++++++ gdb.spec | 12 +- 3 files changed, 756 insertions(+), 1 deletion(-) create mode 100644 gdb-archer-vla-misc.patch create mode 100644 gdb-archer-vla-subarray.patch diff --git a/gdb-archer-vla-misc.patch b/gdb-archer-vla-misc.patch new file mode 100644 index 0000000..a857c59 --- /dev/null +++ b/gdb-archer-vla-misc.patch @@ -0,0 +1,241 @@ +--- ./gdb/defs.h 2011-01-15 20:02:32.000000000 +0100 ++++ ./gdb/defs.h 2011-01-15 20:10:17.000000000 +0100 +@@ -396,6 +396,8 @@ extern struct cleanup *make_cleanup_rest + extern struct cleanup * + set_batch_flag_and_make_cleanup_restore_page_info (void); + ++extern struct cleanup *make_cleanup_restore_selected_frame (void); ++ + extern char *gdb_realpath (const char *); + extern char *xfullpath (const char *); + +--- ./gdb/dwarf2loc.c 2011-01-15 20:02:32.000000000 +0100 ++++ ./gdb/dwarf2loc.c 2011-01-15 20:10:17.000000000 +0100 +@@ -1059,7 +1059,7 @@ dwarf2_evaluate_loc_desc (struct type *t + { + struct value *retval; + struct dwarf_expr_context *ctx; +- struct cleanup *old_chain = make_cleanup (null_cleanup, 0); ++ struct cleanup *old_chain; + + if (size == 0) + { +@@ -1069,6 +1069,8 @@ dwarf2_evaluate_loc_desc (struct type *t + return retval; + } + ++ old_chain = make_cleanup (null_cleanup, 0); ++ + ctx = dwarf_expr_prep_ctx (frame, data, size, per_cu); + + if (ctx->num_pieces > 0) +@@ -1104,6 +1106,10 @@ dwarf2_evaluate_loc_desc (struct type *t + CORE_ADDR address = dwarf_expr_fetch_address (ctx, 0); + int in_stack_memory = dwarf_expr_fetch_in_stack_memory (ctx, 0); + ++ /* Frame may be needed for check_typedef of TYPE_DYNAMIC. */ ++ make_cleanup_restore_selected_frame (); ++ select_frame (frame); ++ + /* object_address_set called here is required in ALLOCATE_VALUE's + CHECK_TYPEDEF for the object's possible + DW_OP_push_object_address. */ +--- ./gdb/dwarf2read.c 2011-01-15 20:02:38.000000000 +0100 ++++ ./gdb/dwarf2read.c 2011-01-15 20:10:17.000000000 +0100 +@@ -7933,7 +7933,9 @@ read_subrange_type (struct die_info *die + high = dwarf2_get_attr_constant_value (attr, 0); + else + { +- TYPE_HIGH_BOUND_UNDEFINED (range_type) = 1; ++ /* Ada expects an empty array on no boundary attributes. */ ++ if (cu->language != language_ada) ++ TYPE_HIGH_BOUND_UNDEFINED (range_type) = 1; + high = low - 1; + } + if (!TYPE_UNSIGNED (base_type) && (high & negative_mask)) +--- ./gdb/stack.c 2011-01-15 20:02:32.000000000 +0100 ++++ ./gdb/stack.c 2011-01-15 20:10:17.000000000 +0100 +@@ -366,6 +366,7 @@ print_frame_args (struct symbol *func, s + { + const struct language_defn *language; + struct value_print_options opts; ++ struct cleanup *old_chain; + + /* Use the appropriate language to display our symbol, + unless the user forced the language to a specific +@@ -378,7 +379,13 @@ print_frame_args (struct symbol *func, s + get_raw_print_options (&opts); + opts.deref_ref = 0; + opts.summary = summary; ++ ++ /* Frame may be needed for check_typedef of TYPE_DYNAMIC. */ ++ old_chain = make_cleanup_restore_selected_frame (); ++ select_frame (frame); + common_val_print (val, stb->stream, 2, &opts, language); ++ do_cleanups (old_chain); ++ + ui_out_field_stream (uiout, "value", stb); + } + else +--- ./gdb/testsuite/gdb.fortran/dynamic-other-frame-stub.f90 1970-01-01 01:00:00.000000000 +0100 ++++ ./gdb/testsuite/gdb.fortran/dynamic-other-frame-stub.f90 2011-01-15 20:03:20.000000000 +0100 +@@ -0,0 +1,24 @@ ++! Copyright 2010 Free Software Foundation, Inc. ++! ++! This program is free software; you can redistribute it and/or modify ++! it under the terms of the GNU General Public License as published by ++! the Free Software Foundation; either version 2 of the License, or ++! (at your option) any later version. ++! ++! This program is distributed in the hope that it will be useful, ++! but WITHOUT ANY WARRANTY; without even the implied warranty of ++! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++! GNU General Public License for more details. ++! ++! You should have received a copy of the GNU General Public License ++! along with this program; if not, write to the Free Software ++! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ++! ++! Ihis file is the Fortran source file for dynamic.exp. ++! Original file written by Jakub Jelinek . ++! Modified for the GDB testcase by Jan Kratochvil . ++ ++subroutine bar ++ real :: dummy ++ dummy = 1 ++end subroutine bar +--- ./gdb/testsuite/gdb.fortran/dynamic-other-frame.exp 1970-01-01 01:00:00.000000000 +0100 ++++ ./gdb/testsuite/gdb.fortran/dynamic-other-frame.exp 2011-01-15 20:03:20.000000000 +0100 +@@ -0,0 +1,37 @@ ++# Copyright 2010 Free Software Foundation, Inc. ++ ++# This program is free software; you can redistribute it and/or modify ++# it under the terms of the GNU General Public License as published by ++# the Free Software Foundation; either version 2 of the License, or ++# (at your option) any later version. ++# ++# This program is distributed in the hope that it will be useful, ++# but WITHOUT ANY WARRANTY; without even the implied warranty of ++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++# GNU General Public License for more details. ++# ++# You should have received a copy of the GNU General Public License ++# along with this program; if not, write to the Free Software ++# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ++ ++set testfile "dynamic-other-frame" ++set srcfile1 ${testfile}.f90 ++set srcfile2 ${testfile}-stub.f90 ++set objfile2 ${objdir}/${subdir}/${testfile}-stub.o ++set executable ${testfile} ++set binfile ${objdir}/${subdir}/${executable} ++ ++if { [gdb_compile "${srcdir}/${subdir}/${srcfile2}" "${objfile2}" object {f77}] != "" ++ || [gdb_compile "${srcdir}/${subdir}/${srcfile1} ${objfile2}" "${binfile}" executable {debug f77}] != "" } { ++ untested "Couldn't compile ${srcfile1} or ${srcfile2}" ++ return -1 ++} ++ ++clean_restart ${executable} ++ ++if ![runto bar_] then { ++ perror "couldn't run to bar_" ++ continue ++} ++ ++gdb_test "bt" {foo \(string='hello'.*} +--- ./gdb/testsuite/gdb.fortran/dynamic-other-frame.f90 1970-01-01 01:00:00.000000000 +0100 ++++ ./gdb/testsuite/gdb.fortran/dynamic-other-frame.f90 2011-01-15 20:03:20.000000000 +0100 +@@ -0,0 +1,36 @@ ++! Copyright 2010 Free Software Foundation, Inc. ++! ++! This program is free software; you can redistribute it and/or modify ++! it under the terms of the GNU General Public License as published by ++! the Free Software Foundation; either version 2 of the License, or ++! (at your option) any later version. ++! ++! This program is distributed in the hope that it will be useful, ++! but WITHOUT ANY WARRANTY; without even the implied warranty of ++! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++! GNU General Public License for more details. ++! ++! You should have received a copy of the GNU General Public License ++! along with this program; if not, write to the Free Software ++! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ++! ++! Ihis file is the Fortran source file for dynamic.exp. ++! Original file written by Jakub Jelinek . ++! Modified for the GDB testcase by Jan Kratochvil . ++ ++subroutine foo (string) ++ interface ++ subroutine bar ++ end subroutine ++ end interface ++ character string*(*) ++ call bar ! stop-here ++end subroutine foo ++program test ++ interface ++ subroutine foo (string) ++ character string*(*) ++ end subroutine ++ end interface ++ call foo ('hello') ++end +--- ./gdb/testsuite/gdb.opt/fortran-string.exp 2011-01-15 20:02:32.000000000 +0100 ++++ ./gdb/testsuite/gdb.opt/fortran-string.exp 2011-01-15 20:10:17.000000000 +0100 +@@ -29,13 +29,11 @@ if { [prepare_for_testing ${test}.exp ${ + return -1 + } + +-if ![runto MAIN__] then { ++if ![runto $srcfile:[gdb_get_line_number "s = s"]] then { + perror "couldn't run to breakpoint MAIN__" + continue + } + +-gdb_breakpoint [gdb_get_line_number "s = s"] +-gdb_continue_to_breakpoint "s = s" + gdb_test "frame" ".*s='foo'.*" + gdb_test "ptype s" "type = character\\*3" + gdb_test "p s" "\\$\[0-9\]* = 'foo'" +--- ./gdb/utils.c 2011-01-15 20:02:38.000000000 +0100 ++++ ./gdb/utils.c 2011-01-15 20:10:17.000000000 +0100 +@@ -2179,6 +2179,36 @@ set_batch_flag_and_make_cleanup_restore_ + return back_to; + } + ++/* Helper for make_cleanup_restore_page_info. */ ++ ++static void ++do_restore_selected_frame_cleanup (void *arg) ++{ ++ struct frame_id *frame_idp = arg; ++ ++ select_frame (frame_find_by_id (*frame_idp)); ++ ++ xfree (frame_idp); ++} ++ ++/* Provide cleanup for restoring currently selected frame. Use frame_id for ++ the case the current frame becomes stale in the meantime. */ ++ ++struct cleanup * ++make_cleanup_restore_selected_frame (void) ++{ ++ struct frame_id *frame_idp; ++ ++ /* get_selected_frame->get_current_frame would error otherwise. */ ++ if (!has_stack_frames ()) ++ return make_cleanup (null_cleanup, NULL); ++ ++ frame_idp = xmalloc (sizeof (*frame_idp)); ++ *frame_idp = get_frame_id (get_selected_frame (NULL)); ++ ++ return make_cleanup (do_restore_selected_frame_cleanup, frame_idp); ++} ++ + /* Set the screen size based on LINES_PER_PAGE and CHARS_PER_LINE. */ + + static void diff --git a/gdb-archer-vla-subarray.patch b/gdb-archer-vla-subarray.patch new file mode 100644 index 0000000..3acbb3b --- /dev/null +++ b/gdb-archer-vla-subarray.patch @@ -0,0 +1,504 @@ +--- ./gdb/eval.c 2011-01-15 20:02:32.000000000 +0100 ++++ ./gdb/eval.c 2011-01-15 20:30:07.000000000 +0100 +@@ -506,27 +506,198 @@ init_array_element (struct value *array, + } + + static struct value * +-value_f90_subarray (struct value *array, +- struct expression *exp, int *pos, enum noside noside) ++value_f90_subarray (struct value *array, struct expression *exp, int *pos, ++ int nargs, enum noside noside) + { +- int pc = (*pos) + 1; +- LONGEST low_bound, high_bound; +- struct type *range = check_typedef (TYPE_INDEX_TYPE (value_type (array))); +- enum f90_range_type range_type = longest_to_int (exp->elts[pc].longconst); +- +- *pos += 3; ++ /* Type to use for the newly allocated value ARRAY. */ ++ struct type *new_array_type; + +- if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT) +- low_bound = TYPE_LOW_BOUND (range); ++ /* Type being iterated for each dimension. */ ++ struct type *type; ++ ++ /* Pointer in the last holder to the type of current dimension. */ ++ struct type **typep = &new_array_type; ++ ++ struct subscript_index ++ { ++ enum { SUBSCRIPT_RANGE, SUBSCRIPT_NUMBER } kind; ++ union ++ { ++ struct subscript_range ++ { ++ enum f90_range_type f90_range_type; ++ LONGEST low_bound, high_bound; ++ } ++ range; ++ LONGEST number; ++ }; ++ } ++ *subscript_array; ++ int i; ++ struct cleanup *old_chain; ++ CORE_ADDR value_byte_address, value_byte_offset = 0; ++ htab_t copied_types; ++ struct value *saved_array; ++ ++ old_chain = make_cleanup (null_cleanup, 0); ++ object_address_set (value_raw_address (array)); ++ ++ if (value_optimized_out (array) ++ || (VALUE_LVAL (array) != not_lval ++ && VALUE_LVAL (array) != lval_memory ++ && VALUE_LVAL (array) != lval_internalvar_component ++ && VALUE_LVAL (array) != lval_internalvar)) ++ error (_("value being subranged must be in memory")); ++ type = check_typedef (value_type (array)); ++ f_object_address_data_valid_or_error (type); ++ ++ copied_types = create_copied_types_hash (NULL); ++ type = copy_type_recursive (type, copied_types); ++ htab_delete (copied_types); ++ ++ if (nargs != calc_f77_array_dims (type)) ++ error (_("Wrong number of subscripts")); ++ ++ if (TYPE_DATA_LOCATION_IS_ADDR (type)) ++ { ++ value_byte_address = (TYPE_DATA_LOCATION_ADDR (type) ++ + value_offset (array)); ++ TYPE_DATA_LOCATION_IS_ADDR (type) = 0; ++ } + else +- low_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside)); ++ value_byte_address = value_address (array); + +- if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT) +- high_bound = TYPE_HIGH_BOUND (range); ++ new_array_type = type; ++ ++ subscript_array = alloca (sizeof (*subscript_array) * nargs); ++ ++ gdb_assert (nargs > 0); ++ ++ /* Now that we know we have a legal array subscript expression ++ let us actually find out where this element exists in the array. */ ++ ++ /* Take array indices left to right. */ ++ for (i = 0; i < nargs; i++) ++ { ++ struct subscript_index *index = &subscript_array[i]; ++ ++ if (exp->elts[*pos].opcode == OP_F90_RANGE) ++ { ++ int pc = (*pos) + 1; ++ struct subscript_range *range; ++ ++ index->kind = SUBSCRIPT_RANGE; ++ range = &index->range; ++ ++ *pos += 3; ++ range->f90_range_type = longest_to_int (exp->elts[pc].longconst); ++ ++ if (range->f90_range_type == HIGH_BOUND_DEFAULT ++ || range->f90_range_type == NONE_BOUND_DEFAULT) ++ range->low_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, ++ pos, noside)); ++ ++ if (range->f90_range_type == LOW_BOUND_DEFAULT ++ || range->f90_range_type == NONE_BOUND_DEFAULT) ++ range->high_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, ++ pos, noside)); ++ } ++ else ++ { ++ struct value *val; ++ ++ index->kind = SUBSCRIPT_NUMBER; ++ ++ /* Evaluate each subscript; it must be a legal integer in F77. */ ++ val = evaluate_subexp_with_coercion (exp, pos, noside); ++ index->number = value_as_long (val); ++ } ++ } ++ ++ /* Internal type of array is arranged right to left. */ ++ for (i = nargs - 1; i >= 0; i--) ++ { ++ struct subscript_index *index = &subscript_array[i]; ++ struct type *range_type = TYPE_INDEX_TYPE (type); ++ ++ switch (index->kind) ++ { ++ case SUBSCRIPT_RANGE: ++ { ++ struct subscript_range *range = &index->range; ++ CORE_ADDR byte_offset; ++ ++ if (range->f90_range_type == LOW_BOUND_DEFAULT ++ || range->f90_range_type == BOTH_BOUND_DEFAULT) ++ range->low_bound = TYPE_LOW_BOUND (range_type); ++ ++ if (range->f90_range_type == HIGH_BOUND_DEFAULT ++ || range->f90_range_type == BOTH_BOUND_DEFAULT) ++ range->high_bound = TYPE_HIGH_BOUND (range_type); ++ ++ if (range->low_bound < TYPE_LOW_BOUND (range_type) ++ || (!TYPE_HIGH_BOUND_UNDEFINED (range_type) ++ && range->high_bound > TYPE_HIGH_BOUND (range_type))) ++ error (_("slice out of range")); ++ ++ byte_offset = ((range->low_bound - TYPE_LOW_BOUND (range_type)) ++ * TYPE_ARRAY_BYTE_STRIDE_VALUE (type)); ++ TYPE_LOW_BOUND (range_type) = range->low_bound; ++ TYPE_HIGH_BOUND (range_type) = range->high_bound; ++ if (range->f90_range_type == LOW_BOUND_DEFAULT ++ || range->f90_range_type == NONE_BOUND_DEFAULT) ++ TYPE_HIGH_BOUND_UNDEFINED (range_type) = 0; ++ ++ typep = &TYPE_TARGET_TYPE (type); ++ value_byte_offset += byte_offset; ++ type = TYPE_TARGET_TYPE (type); ++ } ++ break; ++ ++ case SUBSCRIPT_NUMBER: ++ { ++ CORE_ADDR byte_offset; ++ ++ if (index->number < TYPE_LOW_BOUND (range_type) ++ || (!TYPE_HIGH_BOUND_UNDEFINED (range_type) ++ && index->number > TYPE_HIGH_BOUND (range_type))) ++ error (_("no such vector element")); ++ ++ byte_offset = ((index->number - TYPE_LOW_BOUND (range_type)) ++ * TYPE_ARRAY_BYTE_STRIDE_VALUE (type)); ++ ++ type = TYPE_TARGET_TYPE (type); ++ *typep = type; ++ value_byte_offset += byte_offset; ++ } ++ break; ++ } ++ } ++ ++ check_typedef (new_array_type); ++ saved_array = array; ++ array = allocate_value_lazy (new_array_type); ++ VALUE_LVAL (array) = VALUE_LVAL (saved_array); ++ if (VALUE_LVAL (saved_array) == lval_internalvar_component) ++ VALUE_LVAL (array) = lval_internalvar; + else +- high_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside)); ++ VALUE_LVAL (array) = VALUE_LVAL (saved_array); ++ VALUE_FRAME_ID (array) = VALUE_FRAME_ID (saved_array); ++ if (VALUE_LVAL (array) != lval_internalvar) ++ set_value_address (array, value_byte_address + value_byte_offset); + +- return value_slice (array, low_bound, high_bound - low_bound + 1); ++ if (!value_lazy (saved_array)) ++ { ++ allocate_value_contents (array); ++ set_value_lazy (array, 0); ++ ++ memcpy (value_contents_writeable (array), ++ value_contents (saved_array) + value_byte_offset, ++ TYPE_LENGTH (new_array_type)); ++ } ++ ++ do_cleanups (old_chain); ++ return array; + } + + +@@ -1829,19 +2000,8 @@ evaluate_subexp_standard (struct type *e + switch (code) + { + case TYPE_CODE_ARRAY: +- if (exp->elts[*pos].opcode == OP_F90_RANGE) +- return value_f90_subarray (arg1, exp, pos, noside); +- else +- goto multi_f77_subscript; +- + case TYPE_CODE_STRING: +- if (exp->elts[*pos].opcode == OP_F90_RANGE) +- return value_f90_subarray (arg1, exp, pos, noside); +- else +- { +- arg2 = evaluate_subexp_with_coercion (exp, pos, noside); +- return value_subscript (arg1, value_as_long (arg2)); +- } ++ return value_f90_subarray (arg1, exp, pos, nargs, noside); + + case TYPE_CODE_PTR: + case TYPE_CODE_FUNC: +@@ -2257,104 +2417,6 @@ evaluate_subexp_standard (struct type *e + } + return (arg1); + +- multi_f77_subscript: +- { +- int subscript_array[MAX_FORTRAN_DIMS]; +- int array_size_array[MAX_FORTRAN_DIMS]; +- int byte_stride_array[MAX_FORTRAN_DIMS]; +- int ndimensions = 1, i; +- struct type *tmp_type; +- int offset_item; /* The array offset where the item lives */ +- CORE_ADDR offset_byte; /* byte_stride based offset */ +- unsigned element_size; +- +- if (nargs > MAX_FORTRAN_DIMS) +- error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS); +- +- old_chain = make_cleanup (null_cleanup, 0); +- object_address_set (value_raw_address (arg1)); +- +- tmp_type = check_typedef (value_type (arg1)); +- ndimensions = calc_f77_array_dims (type); +- +- if (nargs != ndimensions) +- error (_("Wrong number of subscripts")); +- +- gdb_assert (nargs > 0); +- +- /* Now that we know we have a legal array subscript expression +- let us actually find out where this element exists in the array. */ +- +- offset_item = 0; +- /* Take array indices left to right */ +- for (i = 0; i < nargs; i++) +- { +- /* Evaluate each subscript, It must be a legal integer in F77 */ +- arg2 = evaluate_subexp_with_coercion (exp, pos, noside); +- +- /* Fill in the subscript and array size arrays */ +- +- subscript_array[i] = value_as_long (arg2); +- } +- +- /* Internal type of array is arranged right to left */ +- for (i = 0; i < nargs; i++) +- { +- upper = f77_get_upperbound (tmp_type); +- lower = f77_get_lowerbound (tmp_type); +- +- byte_stride_array[nargs - i - 1] = +- TYPE_ARRAY_BYTE_STRIDE_VALUE (tmp_type); +- +- array_size_array[nargs - i - 1] = upper - lower + 1; +- +- /* Zero-normalize subscripts so that offsetting will work. */ +- +- subscript_array[nargs - i - 1] -= lower; +- +- /* If we are at the bottom of a multidimensional +- array type then keep a ptr to the last ARRAY +- type around for use when calling value_subscript() +- below. This is done because we pretend to value_subscript +- that we actually have a one-dimensional array +- of base element type that we apply a simple +- offset to. */ +- +- if (i < nargs - 1) +- tmp_type = check_typedef (TYPE_TARGET_TYPE (tmp_type)); +- } +- +- /* Kept for the f77_get_upperbound / f77_get_lowerbound calls above. */ +- do_cleanups (old_chain); +- +- /* Now let us calculate the offset for this item */ +- +- offset_item = 0; +- offset_byte = 0; +- +- for (i = ndimensions - 1; i >= 0; --i) +- { +- offset_item *= array_size_array[i]; +- if (byte_stride_array[i] == 0) +- offset_item += subscript_array[i]; +- else +- offset_byte += subscript_array[i] * byte_stride_array[i]; +- } +- +- element_size = TYPE_LENGTH (TYPE_TARGET_TYPE (tmp_type)); +- offset_byte += offset_item * element_size; +- +- /* Let us now play a dirty trick: we will take arg1 +- which is a value node pointing to the topmost level +- of the multidimensional array-set and pretend +- that it is actually a array of the final element +- type, this will ensure that value_subscript() +- returns the correct type value */ +- +- deprecated_set_value_type (arg1, tmp_type); +- return value_subscripted_rvalue (arg1, offset_byte); +- } +- + case BINOP_LOGICAL_AND: + arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside); + if (noside == EVAL_SKIP) +@@ -3090,18 +3152,25 @@ parse_and_eval_type (char *p, int length + int + calc_f77_array_dims (struct type *array_type) + { +- int ndimen = 1; +- struct type *tmp_type; ++ switch (TYPE_CODE (array_type)) ++ { ++ case TYPE_CODE_STRING: ++ return 1; + +- if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY)) +- error (_("Can't get dimensions for a non-array type")); ++ case TYPE_CODE_ARRAY: ++ { ++ int ndimen = 1; + +- tmp_type = array_type; ++ while ((array_type = TYPE_TARGET_TYPE (array_type))) ++ { ++ if (TYPE_CODE (array_type) == TYPE_CODE_ARRAY) ++ ++ndimen; ++ } ++ return ndimen; ++ } + +- while ((tmp_type = TYPE_TARGET_TYPE (tmp_type))) +- { +- if (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY) +- ++ndimen; ++ default: ++ error (_("Can't get dimensions for a non-array/non-string type")); + } +- return ndimen; ++ + } +--- ./gdb/f-exp.y 2010-06-03 00:41:55.000000000 +0200 ++++ ./gdb/f-exp.y 2011-01-15 20:03:20.000000000 +0100 +@@ -293,7 +293,9 @@ arglist : subrange + { arglist_len = 1; } + ; + +-arglist : arglist ',' exp %prec ABOVE_COMMA ++arglist : arglist ',' exp %prec ABOVE_COMMA ++ { arglist_len++; } ++ | arglist ',' subrange %prec ABOVE_COMMA + { arglist_len++; } + ; + +--- ./gdb/gdbtypes.c 2011-01-15 20:02:38.000000000 +0100 ++++ ./gdb/gdbtypes.c 2011-01-15 20:45:55.000000000 +0100 +@@ -3478,6 +3477,16 @@ copy_type_recursive_1 (struct objfile *o + copy_type_recursive_1 (objfile, + TYPE_VPTR_BASETYPE (type), + copied_types); ++ ++ if (TYPE_CODE (new_type) == TYPE_CODE_ARRAY) ++ { ++ struct type *new_index_type = TYPE_INDEX_TYPE (new_type); ++ ++ if (TYPE_BYTE_STRIDE (new_index_type) == 0) ++ TYPE_BYTE_STRIDE (new_index_type) ++ = TYPE_LENGTH (TYPE_TARGET_TYPE (new_type)); ++ } ++ + /* Maybe copy the type_specific bits. + + NOTE drow/2005-12-09: We do not copy the C++-specific bits like +--- ./gdb/testsuite/gdb.fortran/subrange.exp 1970-01-01 01:00:00.000000000 +0100 ++++ ./gdb/testsuite/gdb.fortran/subrange.exp 2011-01-15 20:03:20.000000000 +0100 +@@ -0,0 +1,51 @@ ++# Copyright 2011 Free Software Foundation, Inc. ++ ++# This program is free software; you can redistribute it and/or modify ++# it under the terms of the GNU General Public License as published by ++# the Free Software Foundation; either version 3 of the License, or ++# (at your option) any later version. ++# ++# This program is distributed in the hope that it will be useful, ++# but WITHOUT ANY WARRANTY; without even the implied warranty of ++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++# GNU General Public License for more details. ++# ++# You should have received a copy of the GNU General Public License ++# along with this program. If not, see . ++ ++if { [skip_fortran_tests] } { return -1 } ++ ++set testfile "subrange" ++set srcfile ${testfile}.f90 ++if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} {debug f77}] } { ++ return -1 ++} ++ ++if ![runto MAIN__] { ++ perror "Couldn't run to MAIN__" ++ continue ++} ++ ++# Depending on the compiler version being used, the name of the 4-byte integer ++# and real types can be printed differently. For instance, gfortran-4.1 uses ++# "int4" whereas gfortran-4.3 uses "int(kind=4)". ++set int4 "(int4|integer\\(kind=4\\))" ++ ++gdb_breakpoint [gdb_get_line_number "break-static"] ++gdb_continue_to_breakpoint "break-static" ".*break-static.*" ++ ++gdb_test "p a (2, 2:3)" { = \(22, 32\)} ++gdb_test "p a (2:3, 3)" { = \(32, 33\)} ++gdb_test "p a (1, 2:)" { = \(21, 31\)} ++gdb_test "p a (2, :2)" { = \(12, 22\)} ++gdb_test "p a (3, 2:2)" { = \(23\)} ++gdb_test "ptype a (3, 2:2)" " = $int4 \\(2:2\\)" ++gdb_test "p a (4, :)" { = \(14, 24, 34\)} ++gdb_test "p a (:, :)" { = \(\( *11, 12, 13, 14\) \( *21, 22, 23, 24\) \( *31, 32, 33, 34\) *\)} ++gdb_test "ptype a (:, :)" " = $int4 \\(4,3\\)" ++gdb_test "p a (:)" "Wrong number of subscripts" ++gdb_test "p a (:, :, :)" "Wrong number of subscripts" ++gdb_test_no_output {set $a=a} ++delete_breakpoints ++gdb_unload ++gdb_test {p $a (3, 2:2)} { = \(23\)} +--- ./gdb/testsuite/gdb.fortran/subrange.f90 1970-01-01 01:00:00.000000000 +0100 ++++ ./gdb/testsuite/gdb.fortran/subrange.f90 2011-01-15 20:03:20.000000000 +0100 +@@ -0,0 +1,23 @@ ++! Copyright 2011 Free Software Foundation, Inc. ++! ++! This program is free software; you can redistribute it and/or modify ++! it under the terms of the GNU General Public License as published by ++! the Free Software Foundation; either version 3 of the License, or ++! (at your option) any later version. ++! ++! This program is distributed in the hope that it will be useful, ++! but WITHOUT ANY WARRANTY; without even the implied warranty of ++! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++! GNU General Public License for more details. ++! ++! You should have received a copy of the GNU General Public License ++! along with this program. If not, see . ++ ++program test ++ integer :: a (4, 3) ++ do 1 i = 1, 4 ++ do 1 j = 1, 3 ++ a (i, j) = j * 10 + i ++1 continue ++ write (*,*) a ! break-static ++end +--- ./gdb/testsuite/lib/gdb.exp 2011-01-15 20:02:38.000000000 +0100 ++++ ./gdb/testsuite/lib/gdb.exp 2011-01-15 20:03:20.000000000 +0100 +@@ -149,6 +149,11 @@ proc gdb_unload {} { + verbose "\t\tKilling previous program being debugged" + exp_continue + } ++ -re "A program is being debugged already..*Are you sure you want to change the file.*y or n. $"\ ++ { send_gdb "y\n" ++ verbose "\t\tUnloading symbols for program being debugged" ++ exp_continue ++ } + -re "Discard symbol table from .*y or n.*$" { + send_gdb "y\n" + exp_continue diff --git a/gdb.spec b/gdb.spec index 2125cb1..9a0a6ad 100644 --- a/gdb.spec +++ b/gdb.spec @@ -27,7 +27,7 @@ Version: 7.2 # The release always contains a leading reserved number, start it at 1. # `upstream' is not a part of `name' to stay fully rpm dependencies compatible for the testing. -Release: 33%{?_with_upstream:.upstream}%{dist} +Release: 34%{?_with_upstream:.upstream}%{dist} License: GPLv3+ and GPLv3+ with exceptions and GPLv2+ and GPLv2+ with exceptions and GPL+ and LGPLv2+ and GFDL and BSD and Public Domain Group: Development/Debuggers @@ -696,6 +696,11 @@ Patch547: gdb-test-dw2-aranges.patch # =fedoratest Patch548: gdb-test-expr-cumulative-archer.patch +# [vla] Support Fortran vector slices and subsets (BZ 609782). +# =drop +Patch549: gdb-archer-vla-misc.patch +Patch550: gdb-archer-vla-subarray.patch + BuildRequires: ncurses-devel%{?_isa} texinfo gettext flex bison expat-devel%{?_isa} Requires: readline%{?_isa} BuildRequires: readline-devel%{?_isa} @@ -994,6 +999,8 @@ rm -f gdb/jv-exp.c gdb/m2-exp.c gdb/objc-exp.c gdb/p-exp.c %patch546 -p1 %patch547 -p1 %patch548 -p1 +%patch549 -p1 +%patch550 -p1 %patch393 -p1 %patch335 -p1 @@ -1385,6 +1392,9 @@ fi %endif %changelog +* Sat Jan 15 2011 Jan Kratochvil - 7.2-34.fc14 +- [vla] Support Fortran vector slices and subsets (BZ 609782). + * Sat Jan 15 2011 Jan Kratochvil - 7.2-33.fc14 - testsuite: Fix gdb-test-expr-cumulative-archer.patch compatibility.