- [vla] Support Fortran vector slices and subsets (BZ 609782).
This commit is contained in:
parent
dcb7514655
commit
18d95bdf87
241
gdb-archer-vla-misc.patch
Normal file
241
gdb-archer-vla-misc.patch
Normal file
@ -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@redhat.com>.
|
||||
+! Modified for the GDB testcase by Jan Kratochvil <jan.kratochvil@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@redhat.com>.
|
||||
+! Modified for the GDB testcase by Jan Kratochvil <jan.kratochvil@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
|
504
gdb-archer-vla-subarray.patch
Normal file
504
gdb-archer-vla-subarray.patch
Normal file
@ -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
|
12
gdb.spec
12
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@redhat.com> - 7.2-34.fc14
|
||||
- [vla] Support Fortran vector slices and subsets (BZ 609782).
|
||||
|
||||
* Sat Jan 15 2011 Jan Kratochvil <jan.kratochvil@redhat.com> - 7.2-33.fc14
|
||||
- testsuite: Fix gdb-test-expr-cumulative-archer.patch compatibility.
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user