Fix crash printing packed record with packed array.

        * ada-lang.c (ada_modulus_from_name): New function.
        (ada_modulus): In the case where the type length is bigger than
        the size of the type used to hold the bounds, try determining
        the modulus from the type name.
        (ada_value_primitive_packed_val): Fix bug in the computation of
        ntarg causing an out-of-buffer invalid access.

2 files changed, 57 insertions, 1 deletions

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 1105853..7ddb7d1 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,5 +1,16 @@
 2009-03-12  Joel Brobecker  <brobecker@adacore.com>
 
+	Fix crash printing packed record with packed array.
+
+	* ada-lang.c (ada_modulus_from_name): New function.
+	(ada_modulus): In the case where the type length is bigger than
+	the size of the type used to hold the bounds, try determining
+	the modulus from the type name.
+	(ada_value_primitive_packed_val): Fix bug in the computation of
+	ntarg causing an out-of-buffer invalid access.
+
+2009-03-12  Joel Brobecker  <brobecker@adacore.com>
+
 	Fix segfault when printing short_integer'last.
 
 	* ada-lang.c (ada_find_any_type): Search in the primitive types
diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index 12ee5cf..6988594 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -2015,6 +2015,7 @@ ada_value_primitive_packed_val (struct value *obj, const gdb_byte *valaddr,
           /* ... And are placed at the beginning (most-significant) bytes
              of the target.  */
           targ = (bit_size + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT - 1;
+          ntarg = targ + 1;
           break;
         default:
           accumSize = 0;
@@ -9597,11 +9598,55 @@ ada_is_modular_type (struct type *type)
           && TYPE_UNSIGNED (subranged_type));
 }
 
+/* Try to determine the lower and upper bounds of the given modular type
+   using the type name only.  Return non-zero and set L and U as the lower
+   and upper bounds (respectively) if successful.  */
+
+int
+ada_modulus_from_name (struct type *type, ULONGEST *modulus)
+{
+  char *name = ada_type_name (type);
+  char *suffix;
+  int k;
+  LONGEST U;
+
+  if (name == NULL)
+    return 0;
+
+  /* Discrete type bounds are encoded using an __XD suffix.  In our case,
+     we are looking for static bounds, which means an __XDLU suffix.
+     Moreover, we know that the lower bound of modular types is always
+     zero, so the actual suffix should start with "__XDLU_0__", and
+     then be followed by the upper bound value.  */
+  suffix = strstr (name, "__XDLU_0__");
+  if (suffix == NULL)
+    return 0;
+  k = 10;
+  if (!ada_scan_number (suffix, k, &U, NULL))
+    return 0;
+
+  *modulus = (ULONGEST) U + 1;
+  return 1;
+}
+
 /* Assuming ada_is_modular_type (TYPE), the modulus of TYPE.  */
 
 ULONGEST
-ada_modulus (struct type * type)
+ada_modulus (struct type *type)
 {
+  ULONGEST modulus;
+
+  /* Normally, the modulus of a modular type is equal to the value of
+     its upper bound + 1.  However, the upper bound is currently stored
+     as an int, which is not always big enough to hold the actual bound
+     value.  To workaround this, try to take advantage of the encoding
+     that GNAT uses with with discrete types.  To avoid some unnecessary
+     parsing, we do this only when the size of TYPE is greater than
+     the size of the field holding the bound.  */
+  if (TYPE_LENGTH (type) > sizeof (TYPE_HIGH_BOUND (type))
+      && ada_modulus_from_name (type, &modulus))
+    return modulus;
+
   return (ULONGEST) (unsigned int) TYPE_HIGH_BOUND (type) + 1;
 }