gdb/
PR fortran/11104 and DWARF unbound arrays detection. * dwarf2read.c (read_subrange_type): Set zero length on unspecified upper bound. Set TYPE_HIGH_BOUND_UNDEFINED if not language_ada on unspecified upper bound. * eval.c (evaluate_subexp_standard) <multi_f77_subscript>: Remove variables array_size_array, tmp_type and offset_item. New variable array. Remove call to f77_get_upperbound. New variables array_type and index. Call value_subscripted_rvalue for each dimenasion. Remove the final call to deprecated_set_value_type. gdb/testsuite/ PR fortran/11104 and DWARF unbound arrays detection. * gdb.fortran/multi-dim.exp: New file. * gdb.fortran/multi-dim.f90: New file.
This commit is contained in:
Jan Kratochvil
parent
41e8491fdf
commit
c2ff108bbd
@ -1,3 +1,16 @@
|
||||
2011-01-12 Andrew Burgess <aburgess@broadcom.com>
|
||||
Jan Kratochvil <jan.kratochvil@redhat.com>
|
||||
|
||||
PR fortran/11104 and DWARF unbound arrays detection.
|
||||
* dwarf2read.c (read_subrange_type): Set zero length on unspecified
|
||||
upper bound. Set TYPE_HIGH_BOUND_UNDEFINED if not language_ada on
|
||||
unspecified upper bound.
|
||||
* eval.c (evaluate_subexp_standard) <multi_f77_subscript>: Remove
|
||||
variables array_size_array, tmp_type and offset_item. New variable
|
||||
array. Remove call to f77_get_upperbound. New variables array_type
|
||||
and index. Call value_subscripted_rvalue for each dimenasion. Remove
|
||||
the final call to deprecated_set_value_type.
|
||||
|
||||
2011-01-12 Jan Kratochvil <jan.kratochvil@redhat.com>
|
||||
|
||||
Make value allocations more lazy.
|
||||
|
||||
@ -8192,6 +8192,11 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
|
||||
int count = dwarf2_get_attr_constant_value (attr, 1);
|
||||
high = low + count - 1;
|
||||
}
|
||||
else
|
||||
{
|
||||
/* Unspecified array length. */
|
||||
high = low - 1;
|
||||
}
|
||||
}
|
||||
|
||||
/* Dwarf-2 specifications explicitly allows to create subrange types
|
||||
@ -8247,6 +8252,10 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
|
||||
if (attr && attr->form == DW_FORM_block1)
|
||||
TYPE_HIGH_BOUND_UNDEFINED (range_type) = 1;
|
||||
|
||||
/* Ada expects an empty array on no boundary attributes. */
|
||||
if (attr == NULL && cu->language != language_ada)
|
||||
TYPE_HIGH_BOUND_UNDEFINED (range_type) = 1;
|
||||
|
||||
name = dwarf2_name (die, cu);
|
||||
if (name)
|
||||
TYPE_NAME (range_type) = name;
|
||||
|
||||
52
gdb/eval.c
52
gdb/eval.c
@ -2354,16 +2354,13 @@ evaluate_subexp_standard (struct type *expect_type,
|
||||
|
||||
multi_f77_subscript:
|
||||
{
|
||||
int subscript_array[MAX_FORTRAN_DIMS];
|
||||
int array_size_array[MAX_FORTRAN_DIMS];
|
||||
LONGEST subscript_array[MAX_FORTRAN_DIMS];
|
||||
int ndimensions = 1, i;
|
||||
struct type *tmp_type;
|
||||
int offset_item; /* The array offset where the item lives. */
|
||||
struct value *array = arg1;
|
||||
|
||||
if (nargs > MAX_FORTRAN_DIMS)
|
||||
error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
|
||||
|
||||
tmp_type = check_typedef (value_type (arg1));
|
||||
ndimensions = calc_f77_array_dims (type);
|
||||
|
||||
if (nargs != ndimensions)
|
||||
@ -2374,59 +2371,28 @@ evaluate_subexp_standard (struct type *expect_type,
|
||||
/* 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. */
|
||||
/* Fill in the subscript array. */
|
||||
|
||||
subscript_array[i] = value_as_long (arg2);
|
||||
}
|
||||
|
||||
/* Internal type of array is arranged right to left. */
|
||||
for (i = 0; i < nargs; i++)
|
||||
for (i = nargs; i > 0; i--)
|
||||
{
|
||||
upper = f77_get_upperbound (tmp_type);
|
||||
lower = f77_get_lowerbound (tmp_type);
|
||||
struct type *array_type = check_typedef (value_type (array));
|
||||
LONGEST index = subscript_array[i - 1];
|
||||
|
||||
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));
|
||||
lower = f77_get_lowerbound (array_type);
|
||||
array = value_subscripted_rvalue (array, index, lower);
|
||||
}
|
||||
|
||||
/* Now let us calculate the offset for this item. */
|
||||
|
||||
offset_item = subscript_array[ndimensions - 1];
|
||||
|
||||
for (i = ndimensions - 1; i > 0; --i)
|
||||
offset_item =
|
||||
array_size_array[i - 1] * offset_item + subscript_array[i - 1];
|
||||
|
||||
/* 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_item, 0);
|
||||
return array;
|
||||
}
|
||||
|
||||
case BINOP_LOGICAL_AND:
|
||||
|
||||
@ -1,3 +1,10 @@
|
||||
2011-01-12 Andrew Burgess <aburgess@broadcom.com>
|
||||
Jan Kratochvil <jan.kratochvil@redhat.com>
|
||||
|
||||
PR fortran/11104 and DWARF unbound arrays detection.
|
||||
* gdb.fortran/multi-dim.exp: New file.
|
||||
* gdb.fortran/multi-dim.f90: New file.
|
||||
|
||||
2011-01-12 Andrew Burgess <aburgess@broadcom.com>
|
||||
|
||||
* gdb.mi/mi-disassemble.exp, gdb.mi/mi2-disassemble.exp: Update
|
||||
|
||||
77
gdb/testsuite/gdb.fortran/multi-dim.exp
Normal file
77
gdb/testsuite/gdb.fortran/multi-dim.exp
Normal file
@ -0,0 +1,77 @@
|
||||
# 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/>.
|
||||
|
||||
# This file is part of the gdb testsuite. It contains tests for evaluating
|
||||
# Fortran subarray expression.
|
||||
|
||||
if { [skip_fortran_tests] } { return -1 }
|
||||
|
||||
set testfile "multi-dim"
|
||||
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 "print foo(2,3,4)" \
|
||||
" = 20" \
|
||||
"print valid static array element"
|
||||
|
||||
gdb_test "print foo(0,0,0)" \
|
||||
"no such vector element" \
|
||||
"print an invalid array index (0,0,0)"
|
||||
|
||||
gdb_test "print foo(2,3,5)" \
|
||||
"no such vector element" \
|
||||
"print an invalid array index (2,3,5)"
|
||||
|
||||
gdb_test "print foo(2,4,4)" \
|
||||
"no such vector element" \
|
||||
"print an invalid array index (2,4,4)"
|
||||
|
||||
gdb_test "print foo(3,3,4)" \
|
||||
"no such vector element" \
|
||||
"print an invalid array index (3,3,4)"
|
||||
|
||||
gdb_test "print foo" \
|
||||
{ = \(\( \( 10, 10\) \( 10, 10\) \( 10, 10\) \) \( \( 10, 10\) \( 10, 10\) \( 10, 10\) \) \( \( 10, 10\) \( 10, 10\) \( 10, 10\) \) \( \( 10, 10\) \( 10, 10\) \( 10, 20\) \) \)} \
|
||||
"print full contents of the array"
|
||||
|
||||
gdb_breakpoint [gdb_get_line_number "break-variable"]
|
||||
gdb_continue_to_breakpoint "break-variable" ".*break-variable.*"
|
||||
|
||||
gdb_test "print varbound(4)" \
|
||||
" = 2" \
|
||||
"print valid variable bound array element"
|
||||
|
||||
gdb_test "ptype unbound" \
|
||||
"type = $int4 \\(\\*\\)" \
|
||||
"print type of unbound array"
|
||||
|
||||
gdb_test "print unbound(4)" \
|
||||
" = 2" \
|
||||
"print valid unbound array element"
|
||||
29
gdb/testsuite/gdb.fortran/multi-dim.f90
Normal file
29
gdb/testsuite/gdb.fortran/multi-dim.f90
Normal file
@ -0,0 +1,29 @@
|
||||
! 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 :: foo (2, 3, 4)
|
||||
integer :: singledim (4)
|
||||
foo (:, :, :) = 10
|
||||
foo (2, 3, 4) = 20
|
||||
foo (2, 3, 4) = 20 ! break-static
|
||||
singledim (:) = 1
|
||||
singledim (4) = 2
|
||||
call sub (singledim, 4, singledim)
|
||||
end
|
||||
subroutine sub (varbound, n, unbound)
|
||||
integer :: n, varbound (n), unbound (*)
|
||||
varbound (4) = unbound (4) ! break-variable
|
||||
end
|
||||
Loading…
Reference in New Issue
Block a user