gdb/
authorJan Kratochvil <jan.kratochvil@redhat.com>
Wed, 12 Jan 2011 16:16:24 +0000 (16:16 +0000)
committerJan Kratochvil <jan.kratochvil@redhat.com>
Wed, 12 Jan 2011 16:16:24 +0000 (16:16 +0000)
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.

gdb/ChangeLog
gdb/dwarf2read.c
gdb/eval.c
gdb/testsuite/ChangeLog
gdb/testsuite/gdb.fortran/multi-dim.exp [new file with mode: 0644]
gdb/testsuite/gdb.fortran/multi-dim.f90 [new file with mode: 0644]

index f925b9f..89ea6ac 100644 (file)
@@ -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.
index 2161c74..03bd331 100644 (file)
@@ -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;
index d3cb52c..de25b39 100644 (file)
@@ -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:
index a3fc4e4..ed50974 100644 (file)
@@ -1,4 +1,11 @@
 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
        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 (file)
index 0000000..d41ce0f
--- /dev/null
@@ -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"
diff --git a/gdb/testsuite/gdb.fortran/multi-dim.f90 b/gdb/testsuite/gdb.fortran/multi-dim.f90
new file mode 100644 (file)
index 0000000..647c1a6
--- /dev/null
@@ -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