From c2ff108bbd19e8855e4c5318acd166a06c566b63 Mon Sep 17 00:00:00 2001 From: Jan Kratochvil Date: Wed, 12 Jan 2011 16:16:24 +0000 Subject: [PATCH] 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) : 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. --- gdb/ChangeLog | 13 ++++++ gdb/dwarf2read.c | 9 ++++ gdb/eval.c | 52 ++++------------------ gdb/testsuite/ChangeLog | 7 +++ gdb/testsuite/gdb.fortran/multi-dim.exp | 77 +++++++++++++++++++++++++++++++++ gdb/testsuite/gdb.fortran/multi-dim.f90 | 29 +++++++++++++ 6 files changed, 144 insertions(+), 43 deletions(-) create mode 100644 gdb/testsuite/gdb.fortran/multi-dim.exp create mode 100644 gdb/testsuite/gdb.fortran/multi-dim.f90 diff --git a/gdb/ChangeLog b/gdb/ChangeLog index f925b9f..89ea6ac 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,16 @@ +2011-01-12 Andrew Burgess + Jan Kratochvil + + 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) : 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 Make value allocations more lazy. diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c index 2161c74..03bd331 100644 --- a/gdb/dwarf2read.c +++ b/gdb/dwarf2read.c @@ -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; diff --git a/gdb/eval.c b/gdb/eval.c index d3cb52c..de25b39 100644 --- a/gdb/eval.c +++ b/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); - - 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. */ + struct type *array_type = check_typedef (value_type (array)); + LONGEST index = subscript_array[i - 1]; - 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: diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog index a3fc4e4..ed50974 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,4 +1,11 @@ 2011-01-12 Andrew Burgess + Jan Kratochvil + + 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 * gdb.mi/mi-disassemble.exp, gdb.mi/mi2-disassemble.exp: Update expected output to reflect changes in gdb/mi/mi-cmd-disas.c and diff --git a/gdb/testsuite/gdb.fortran/multi-dim.exp b/gdb/testsuite/gdb.fortran/multi-dim.exp new file mode 100644 index 0000000..d41ce0f --- /dev/null +++ b/gdb/testsuite/gdb.fortran/multi-dim.exp @@ -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 . + +# 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" diff --git a/gdb/testsuite/gdb.fortran/multi-dim.f90 b/gdb/testsuite/gdb.fortran/multi-dim.f90 new file mode 100644 index 0000000..647c1a6 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/multi-dim.f90 @@ -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 . + +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 -- 2.7.4