[gdb/f14/master] - [vla] Support Fortran vector slices and subsets (BZ 609782).
Jan Kratochvil
jankratochvil at fedoraproject.org
Sat Jan 15 20:18:12 UTC 2011
commit 18d95bdf87080e1574aa2758ba9b977033ef84ee
Author: Jan Kratochvil <jan.kratochvil at redhat.com>
Date: Sat Jan 15 21:17:58 2011 +0100
- [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 deletions(-)
---
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 <jakub at redhat.com>.
++! Modified for the GDB testcase by Jan Kratochvil <jan.kratochvil at redhat.com>.
++
++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 <jakub at redhat.com>.
++! Modified for the GDB testcase by Jan Kratochvil <jan.kratochvil at redhat.com>.
++
++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 <http://www.gnu.org/licenses/>.
++
++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 <http://www.gnu.org/licenses/>.
++
++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 <jan.kratochvil at redhat.com> - 7.2-34.fc14
+- [vla] Support Fortran vector slices and subsets (BZ 609782).
+
* Sat Jan 15 2011 Jan Kratochvil <jan.kratochvil at redhat.com> - 7.2-33.fc14
- testsuite: Fix gdb-test-expr-cumulative-archer.patch compatibility.
More information about the scm-commits
mailing list