rpms
/
gdb
2
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
gdb/gdb-archer-vla-subarray.patch

505 lines
16 KiB
Diff
Raw Permalink Blame History

--- ./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
Reference in New Issue View Git Blame Copy Permalink