varsize-limit error printing element of packed array...

... when that packed array is part of a discriminated record and
one of the bounds is a discriminant.

Consider the following code:

   type FUNNY_CHAR_T is (NUL, ' ', '"', '#', [etc]);
   type FUNNY_STR_T is array (POSITIVE range <>) of FUNNY_CHAR_T;
   pragma PACK (FUNNY_STR_T);
   type FUNNY_STRING_T (SIZE : NATURAL := 1) is
      record
         STR    : FUNNY_STR_T (1 .. SIZE) := (others => '0');
         LENGTH : NATURAL := 4;
      end record;
   TEST: FUNNY_STRING_T(100);

GDB is able to print the value of variable "test" and "test.str".
But not "test.str(1)":

    (gdb) p test
    $1 = (size => 100, str => (33 'A', nul <repeats 99 times>), length => 1)
    (gdb) p test.str
    $2 = (33 'A', nul <repeats 99 times>)
    (gdb) p test.str(1)
    object size is larger than varsize-limit

The problem occurs during the phase where we are trying to resolve
the expression subscript operation. On the one hand of the subscript
operator, we have the result of the evaluation of "test.str", which
is our packed array. We have the following code to handle packed
arrays in particular:

      if (ada_is_constrained_packed_array_type
          (desc_base_type (value_type (argvec[0]))))
        argvec[0] = ada_coerce_to_simple_array (argvec[0]);

This eventually leads to a call to constrained_packed_array_type
to return the "simple array".  This function relies on a parallel
___XA type, when available, to determine the bounds.  In our case,
we find type...

    failure__funny_string_t__T4b___XA"

... which has one field describing the bounds of our array as:

    failure__funny_string_t__T3b___XDLU_1__size

The part that interests us is after the ___XD suffix or,
in other words: "LU_1__size". What this means in GNAT encoding
parlance is that the lower bound is 1, and that the upper bound
is the value of "size". "size" is our discriminant in this case.

Normally, we would access the record's discriminant in order to
get the upper bound's value, but we do not have that information,
here. We are in a mode where we are just trying to "fix" the type
without an actual value. This is what the call to to_fixed_range_type
is doing, and because the fix'ing fails, it ends up returning
the ___XDLU type unmodified as our index type.

This shouldn't be a problem, except that the later part of
constrained_packed_array_type then uses that index_type to
determine the array size, via a call to get_discrete_bounds.
The problem is that the upper bound of the ___XDLU type is
dynamic (in the DWARF sense) while get_discrete_bounds implicitly
assumes that the bounds are static, and therefore accesses
them using macros that assume the bounds values are constants:

    case TYPE_CODE_RANGE:
      *lowp = TYPE_LOW_BOUND (type);
      *highp = TYPE_HIGH_BOUND (type);

This therefore returns a bogus value for the upper bound,
leading to an unexpectedly large size for our array, which
later triggers the varsize-limit guard we've seen above.

This patch avoids the problem by adding special handling
of dynamic range types. It also extends the documentation
of the constrained_packed_array_type function to document
what happens in this situation.

gdb/ChangeLog:

        * ada-lang.c (constrained_packed_array_type): Set the length
        of the return array as if both bounds where zero if that
        returned array's index type is dynamic.

gdb/testsuite/ChangeLog:

        * gdb.ada/pkd_arr_elem: New Testcase.

Tested on x86_64-linux.

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index e3e2849ac4e46f57767b265799321e09c8255c7b..fc336adfabaf86ab208938ef6f0c45345d0c816d 100644 (file)
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,9 @@
+2014-11-19  Joel Brobecker  <brobecker@adacore.com>
+
+       * ada-lang.c (constrained_packed_array_type): Set the length
+       of the return array as if both bounds where zero if that
+       returned array's index type is dynamic.
+
 2014-11-19  Yao Qi  <yao@codesourcery.com>
 
        * config/i386/go32.mh (CC): Remove.

diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index e226edbe8874ffaad68e4f224b64048661c26a9c..b3bb57c363b0559726ec8837d13f3be4c710517f 100644 (file)
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -2146,7 +2146,15 @@ decode_packed_array_bitsize (struct type *type)
    but with the bit sizes of its elements (and those of any
    constituent arrays) recorded in the BITSIZE components of its
    TYPE_FIELD_BITSIZE values, and with *ELT_BITS set to its total size
-   in bits.  */
+   in bits.
+
+   Note that, for arrays whose index type has an XA encoding where
+   a bound references a record discriminant, getting that discriminant,
+   and therefore the actual value of that bound, is not possible
+   because none of the given parameters gives us access to the record.
+   This function assumes that it is OK in the context where it is being
+   used to return an array whose bounds are still dynamic and where
+   the length is arbitrary.  */
 
 static struct type *
 constrained_packed_array_type (struct type *type, long *elt_bits)
@@ -2176,7 +2184,9 @@ constrained_packed_array_type (struct type *type, long *elt_bits)
   TYPE_FIELD_BITSIZE (new_type, 0) = *elt_bits;
   TYPE_NAME (new_type) = ada_type_name (type);
 
-  if (get_discrete_bounds (index_type, &low_bound, &high_bound) < 0)
+  if ((TYPE_CODE (check_typedef (index_type)) == TYPE_CODE_RANGE
+       && is_dynamic_type (check_typedef (index_type)))
+      || get_discrete_bounds (index_type, &low_bound, &high_bound) < 0)
     low_bound = high_bound = 0;
   if (high_bound < low_bound)
     *elt_bits = TYPE_LENGTH (new_type) = 0;

diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index ba35db1846081725aae96e0f0080939d7f3510df..e86de0a1f4752351f3ef16051dfef80d3bc1d2d8 100644 (file)
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2014-11-19  Joel Brobecker  <brobecker@adacore.com>
+
+       * gdb.ada/pkd_arr_elem: New Testcase.
+
 2014-11-18  Luis Machado  <lgustavo@codesourcery.com>
 
        * gdb.reverse/break-precsave: Expect completion message for

diff --git a/gdb/testsuite/gdb.ada/pkd_arr_elem.exp b/gdb/testsuite/gdb.ada/pkd_arr_elem.exp
new file mode 100644 (file)
index 0000000..5154050
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/pkd_arr_elem.exp
@@ -0,0 +1,38 @@
+# Copyright 2014 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/>.
+
+load_lib "ada.exp"
+
+if { [skip_ada_tests] } { return -1 }
+
+standard_ada_testfile failure
+
+if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug}] != ""} {
+    return -1
+}
+
+clean_restart ${testfile}
+
+set bp_location [gdb_get_line_number "START" ${testdir}/failure.adb]
+runto "failure.adb:$bp_location"
+
+gdb_test "print test" \
+         "= \\(size => 100, str => \\(33 'A', nul <repeats 99 times>\\), length => 1\\)"
+
+gdb_test "print test.str" \
+         "= \\(33 'A', nul <repeats 99 times>\\)"
+
+gdb_test "print test.str(1)" \
+         "= 33 'A'"

diff --git a/gdb/testsuite/gdb.ada/pkd_arr_elem/failure.adb b/gdb/testsuite/gdb.ada/pkd_arr_elem/failure.adb
new file mode 100644 (file)
index 0000000..13ddaf4
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/pkd_arr_elem/failure.adb
@@ -0,0 +1,45 @@
+--  Copyright 2014 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/>.
+
+with Pck; use Pck;
+
+procedure Failure is
+
+   type Funny_Char is
+        (NUL, ' ', '"', '#', '$', TMI, '&', ''',
+         '(', ')', SOT, ND,  ',', '-', '.', '/',
+         '0', '1', '2', '3', '4', '5', '6', '7',
+         '8', '9', ':', ';', UNS, INF, XMT, '?',
+         '!', 'A', 'B', 'C', 'D', 'E', 'F', 'G',
+         'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O',
+         'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W',
+         'X', 'Y', 'Z', BEL, SND, CR,  LF,  DLT);
+
+   type Funny_String is array (Positive range <>) of Funny_Char;
+   pragma Pack (Funny_String);
+
+   type Bounded_Funny_String (Size : Natural := 1) is
+      record
+         Str    : Funny_String (1 .. Size) := (others => '0');
+         Length : Natural := 4;
+      end record;
+
+   Test : Bounded_Funny_String (100);
+begin
+   Test.Str := (1 => 'A', others => NUL);
+   Test.Length := 1;
+   Do_Nothing (Test'Address); -- START
+end;
+

diff --git a/gdb/testsuite/gdb.ada/pkd_arr_elem/pck.adb b/gdb/testsuite/gdb.ada/pkd_arr_elem/pck.adb
new file mode 100644 (file)
index 0000000..2b31332
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/pkd_arr_elem/pck.adb
@@ -0,0 +1,21 @@
+--  Copyright 2014 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/>.
+
+package body Pck is
+   procedure Do_Nothing (A : System.Address) is
+   begin
+      null;
+   end Do_Nothing;
+end Pck;

diff --git a/gdb/testsuite/gdb.ada/pkd_arr_elem/pck.ads b/gdb/testsuite/gdb.ada/pkd_arr_elem/pck.ads
new file mode 100644 (file)
index 0000000..100d7d5
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/pkd_arr_elem/pck.ads
@@ -0,0 +1,19 @@
+--  Copyright 2014 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/>.
+
+with System;
+package Pck is
+   procedure Do_Nothing (A : System.Address);
+end Pck;