Varobj support for Ada.
authorJoel Brobecker <brobecker@gnat.com>
Wed, 28 Mar 2012 21:31:18 +0000 (21:31 +0000)
committerJoel Brobecker <brobecker@gnat.com>
Wed, 28 Mar 2012 21:31:18 +0000 (21:31 +0000)
This patch adds varobj support for Ada variables.  Most of the code
is implemented in a separate Ada-specific file called ada-varobj.c.
The only bits in varobj.c are the functions used as the hooks in
the language-specific varobj's vector.

gdb/ChangeLog:

        * ada-varobj.h, ada-varobj.c: New files.
        * Makefile.in (SFILES): Add ada-varobj.c.
        (HFILES_NO_SRCDIR): Add ada-varobj.h.
        (COMMON_OBS): Add ada-varobj.o.

gdb/ChangeLog
gdb/Makefile.in
gdb/ada-varobj.c [new file with mode: 0644]
gdb/ada-varobj.h [new file with mode: 0644]
gdb/varobj.c

index 7eeae6d..4890578 100644 (file)
@@ -1,5 +1,12 @@
 2012-03-28  Joel Brobecker  <brobecker@adacore.com>
 
+       * ada-varobj.h, ada-varobj.c: New files.
+       * Makefile.in (SFILES): Add ada-varobj.c.
+       (HFILES_NO_SRCDIR): Add ada-varobj.h.
+       (COMMON_OBS): Add ada-varobj.o.
+
+2012-03-28  Joel Brobecker  <brobecker@adacore.com>
+
        * varobj.c (ada_value_has_mutated): Add declaration.  New function.
        (struct language_specific): New field "value_has_mutated".
        (languages): Set field "value_has_mutated" in each entry of array.
index 4d85662..44d76f2 100644 (file)
@@ -682,6 +682,7 @@ TARGET_FLAGS_TO_PASS = \
 # SFILES is used in building the distribution archive.
 
 SFILES = ada-exp.y ada-lang.c ada-typeprint.c ada-valprint.c ada-tasks.c \
+       ada-varobj.c \
        addrmap.c \
        auxv.c ax-general.c ax-gdb.c \
        agent.c \
@@ -766,7 +767,7 @@ proc-utils.h arm-tdep.h ax-gdb.h ppcnbsd-tdep.h     \
 cli-out.h gdb_expat.h breakpoint.h infcall.h obsd-tdep.h \
 exec.h m32r-tdep.h osabi.h gdbcore.h solib-som.h amd64bsd-nat.h \
 i386bsd-nat.h xml-support.h xml-tdesc.h alphabsd-tdep.h gdb_obstack.h \
-ia64-tdep.h ada-lang.h varobj.h frv-tdep.h nto-tdep.h serial.h \
+ia64-tdep.h ada-lang.h ada-varobj.h varobj.h frv-tdep.h nto-tdep.h serial.h \
 c-lang.h d-lang.h frame.h event-loop.h block.h cli/cli-setshow.h       \
 cli/cli-decode.h cli/cli-cmds.h cli/cli-dump.h cli/cli-utils.h \
 cli/cli-script.h macrotab.h symtab.h version.h gnulib/wchar.in.h \
@@ -883,7 +884,7 @@ COMMON_OBS = $(DEPFILES) $(CONFIG_OBS) $(YYOBJ) \
        dwarf2read.o mipsread.o stabsread.o corefile.o \
        dwarf2expr.o dwarf2loc.o dwarf2-frame.o dwarf2-frame-tailcall.o \
        ada-lang.o c-lang.o d-lang.o f-lang.o objc-lang.o \
-       ada-tasks.o \
+       ada-tasks.o ada-varobj.o \
        ui-out.o cli-out.o \
        varobj.o vec.o \
        jv-lang.o jv-valprint.o jv-typeprint.o \
diff --git a/gdb/ada-varobj.c b/gdb/ada-varobj.c
new file mode 100644 (file)
index 0000000..31f80f5
--- /dev/null
@@ -0,0 +1,889 @@
+/* varobj support for Ada.
+
+   Copyright (C) 2012 Free Software Foundation, Inc.
+
+   This file is part of GDB.
+
+   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/>.  */
+
+#include "defs.h"
+#include "ada-varobj.h"
+#include "ada-lang.h"
+#include "language.h"
+#include "valprint.h"
+
+/* Implementation principle used in this unit:
+
+   For our purposes, the meat of the varobj object is made of two
+   elements: The varobj's (struct) value, and the varobj's (struct)
+   type.  In most situations, the varobj has a non-NULL value, and
+   the type becomes redundant, as it can be directly derived from
+   the value.  In the initial implementation of this unit, most
+   routines would only take a value, and return a value.
+
+   But there are many situations where it is possible for a varobj
+   to have a NULL value.  For instance, if the varobj becomes out of
+   scope.  Or better yet, when the varobj is the child of another
+   NULL pointer varobj.  In that situation, we must rely on the type
+   instead of the value to create the child varobj.
+
+   That's why most functions below work with a (value, type) pair.
+   The value may or may not be NULL.  But the type is always expected
+   to be set.  When the value is NULL, then we work with the type
+   alone, and keep the value NULL.  But when the value is not NULL,
+   then we work using the value, because it provides more information.
+   But we still always set the type as well, even if that type could
+   easily be derived from the value.  The reason behind this is that
+   it allows the code to use the type without having to worry about
+   it being set or not.  It makes the code clearer.  */
+
+/* A convenience function that decodes the VALUE_PTR/TYPE_PTR couple:
+   If there is a value (*VALUE_PTR not NULL), then perform the decoding
+   using it, and compute the associated type from the resulting value.
+   Otherwise, compute a static approximation of *TYPE_PTR, leaving
+   *VALUE_PTR unchanged.
+
+   The results are written in place.  */
+
+static void
+ada_varobj_decode_var (struct value **value_ptr, struct type **type_ptr)
+{
+  if (*value_ptr)
+    {
+      *value_ptr = ada_get_decoded_value (*value_ptr);
+      *type_ptr = ada_check_typedef (value_type (*value_ptr));
+    }
+  else
+    *type_ptr = ada_get_decoded_type (*type_ptr);
+}
+
+/* Return a string containing an image of the given scalar value.
+   VAL is the numeric value, while TYPE is the value's type.
+   This is useful for plain integers, of course, but even more
+   so for enumerated types.
+
+   The result should be deallocated by xfree after use.  */
+
+static char *
+ada_varobj_scalar_image (struct type *type, LONGEST val)
+{
+  struct ui_file *buf = mem_fileopen ();
+  struct cleanup *cleanups = make_cleanup_ui_file_delete (buf);
+  char *result;
+
+  ada_print_scalar (type, val, buf);
+  result = ui_file_xstrdup (buf, NULL);
+  do_cleanups (cleanups);
+
+  return result;
+}
+
+/* Assuming that the (PARENT_VALUE, PARENT_TYPE) pair designates
+   a struct or union, compute the (CHILD_VALUE, CHILD_TYPE) couple
+   corresponding to the field number FIELDNO.  */
+
+static void
+ada_varobj_struct_elt (struct value *parent_value,
+                      struct type *parent_type,
+                      int fieldno,
+                      struct value **child_value,
+                      struct type **child_type)
+{
+  struct value *value = NULL;
+  struct type *type = NULL;
+
+  if (parent_value)
+    {
+      value = value_field (parent_value, fieldno);
+      type = value_type (value);
+    }
+  else
+    type = TYPE_FIELD_TYPE (parent_type, fieldno);
+
+  if (child_value)
+    *child_value = value;
+  if (child_type)
+    *child_type = type;
+}
+
+/* Assuming that the (PARENT_VALUE, PARENT_TYPE) pair is a pointer or
+   reference, return a (CHILD_VALUE, CHILD_TYPE) couple corresponding
+   to the dereferenced value.  */
+
+static void
+ada_varobj_ind (struct value *parent_value,
+               struct type *parent_type,
+               struct value **child_value,
+               struct type **child_type)
+{
+  struct value *value = NULL;
+  struct type *type = NULL;
+
+  if (ada_is_array_descriptor_type (parent_type))
+    {
+      /* This can only happen when PARENT_VALUE is NULL.  Otherwise,
+        ada_get_decoded_value would have transformed our parent_type
+        into a simple array pointer type.  */
+      gdb_assert (parent_value == NULL);
+      gdb_assert (TYPE_CODE (parent_type) == TYPE_CODE_TYPEDEF);
+
+      /* Decode parent_type by the equivalent pointer to (decoded)
+        array.  */
+      while (TYPE_CODE (parent_type) == TYPE_CODE_TYPEDEF)
+       parent_type = TYPE_TARGET_TYPE (parent_type);
+      parent_type = ada_coerce_to_simple_array_type (parent_type);
+      parent_type = lookup_pointer_type (parent_type);
+    }
+
+  /* If parent_value is a null pointer, then only perform static
+     dereferencing.  We cannot dereference null pointers.  */
+  if (parent_value && value_as_address (parent_value) == 0)
+    parent_value = NULL;
+
+  if (parent_value)
+    {
+      value = ada_value_ind (parent_value);
+      type = value_type (value);
+    }
+  else
+    type = TYPE_TARGET_TYPE (parent_type);
+
+  if (child_value)
+    *child_value = value;
+  if (child_type)
+    *child_type = type;
+}
+
+/* Assuming that the (PARENT_VALUE, PARENT_TYPE) pair is a simple
+   array (TYPE_CODE_ARRAY), return the (CHILD_VALUE, CHILD_TYPE)
+   pair corresponding to the element at ELT_INDEX.  */
+
+static void
+ada_varobj_simple_array_elt (struct value *parent_value,
+                            struct type *parent_type,
+                            int elt_index,
+                            struct value **child_value,
+                            struct type **child_type)
+{
+  struct value *value = NULL;
+  struct type *type = NULL;
+
+  if (parent_value)
+    {
+      struct value *index_value =
+       value_from_longest (TYPE_INDEX_TYPE (parent_type), elt_index);
+
+      value = ada_value_subscript (parent_value, 1, &index_value);
+      type = value_type (value);
+    }
+  else
+    type = TYPE_TARGET_TYPE (parent_type);
+
+  if (child_value)
+    *child_value = value;
+  if (child_type)
+    *child_type = type;
+}
+
+/* Given the decoded value and decoded type of a variable object,
+   adjust the value and type to those necessary for getting children
+   of the variable object.
+
+   The replacement is performed in place.  */
+
+static void
+ada_varobj_adjust_for_child_access (struct value **value,
+                                   struct type **type)
+{
+   /* Pointers to struct/union types are special: Instead of having
+      one child (the struct), their children are the components of
+      the struct/union type.  We handle this situation by dereferencing
+      the (value, type) couple.  */
+  if (TYPE_CODE (*type) == TYPE_CODE_PTR
+      && (TYPE_CODE (TYPE_TARGET_TYPE (*type)) == TYPE_CODE_STRUCT
+          || TYPE_CODE (TYPE_TARGET_TYPE (*type)) == TYPE_CODE_UNION)
+      && !ada_is_array_descriptor_type (TYPE_TARGET_TYPE (*type))
+      && !ada_is_constrained_packed_array_type (TYPE_TARGET_TYPE (*type)))
+    ada_varobj_ind (*value, *type, value, type);
+}
+
+/* Assuming that the (PARENT_VALUE, PARENT_TYPE) pair is an array
+   (any type of array, "simple" or not), return the number of children
+   that this array contains.  */
+
+static int
+ada_varobj_get_array_number_of_children (struct value *parent_value,
+                                        struct type *parent_type)
+{
+  LONGEST lo, hi;
+  int len;
+
+  if (!get_array_bounds (parent_type, &lo, &hi))
+    {
+      /* Could not get the array bounds.  Pretend this is an empty array.  */
+      warning (_("unable to get bounds of array, assuming null array"));
+      return 0;
+    }
+
+  /* Ada allows the upper bound to be less than the lower bound,
+     in order to specify empty arrays...  */
+  if (hi < lo)
+    return 0;
+
+  return hi - lo + 1;
+}
+
+/* Assuming that the (PARENT_VALUE, PARENT_TYPE) pair is a struct or
+   union, return the number of children this struct contains.  */
+
+static int
+ada_varobj_get_struct_number_of_children (struct value *parent_value,
+                                         struct type *parent_type)
+{
+  int n_children = 0;
+  int i;
+
+  gdb_assert (TYPE_CODE (parent_type) == TYPE_CODE_STRUCT
+             || TYPE_CODE (parent_type) == TYPE_CODE_UNION);
+
+  for (i = 0; i < TYPE_NFIELDS (parent_type); i++)
+    {
+      if (ada_is_ignored_field (parent_type, i))
+       continue;
+
+      if (ada_is_wrapper_field (parent_type, i))
+       {
+         struct value *elt_value;
+         struct type *elt_type;
+
+         ada_varobj_struct_elt (parent_value, parent_type, i,
+                                &elt_value, &elt_type);
+         if (ada_is_tagged_type (elt_type, 0))
+           {
+             /* We must not use ada_varobj_get_number_of_children
+                to determine is element's number of children, because
+                this function first calls ada_varobj_decode_var,
+                which "fixes" the element.  For tagged types, this
+                includes reading the object's tag to determine its
+                real type, which happens to be the parent_type, and
+                leads to an infinite loop (because the element gets
+                fixed back into the parent).  */
+             n_children += ada_varobj_get_struct_number_of_children
+               (elt_value, elt_type);
+           }
+         else
+           n_children += ada_varobj_get_number_of_children (elt_value, elt_type);
+       }
+      else if (ada_is_variant_part (parent_type, i))
+       {
+         /* In normal situations, the variant part of the record should
+            have been "fixed". Or, in other words, it should have been
+            replaced by the branch of the variant part that is relevant
+            for our value.  But there are still situations where this
+            can happen, however (Eg. when our parent is a NULL pointer).
+            We do not support showing this part of the record for now,
+            so just pretend this field does not exist.  */
+       }
+      else
+       n_children++;
+    }
+
+  return n_children;
+}
+
+/* Assuming that the (PARENT_VALUE, PARENT_TYPE) pair designates
+   a pointer, return the number of children this pointer has.  */
+
+static int
+ada_varobj_get_ptr_number_of_children (struct value *parent_value,
+                                      struct type *parent_type)
+{
+  struct type *child_type = TYPE_TARGET_TYPE (parent_type);
+
+  /* Pointer to functions and to void do not have a child, since
+     you cannot print what they point to.  */
+  if (TYPE_CODE (child_type) == TYPE_CODE_FUNC
+      || TYPE_CODE (child_type) == TYPE_CODE_VOID)
+    return 0;
+
+  /* All other types have 1 child.  */
+  return 1;
+}
+
+/* Return the number of children for the (PARENT_VALUE, PARENT_TYPE)
+   pair.  */
+
+int
+ada_varobj_get_number_of_children (struct value *parent_value,
+                                  struct type *parent_type)
+{
+  ada_varobj_decode_var (&parent_value, &parent_type);
+  ada_varobj_adjust_for_child_access (&parent_value, &parent_type);
+
+  /* A typedef to an array descriptor in fact represents a pointer
+     to an unconstrained array.  These types always have one child
+     (the unconstrained array).  */
+  if (ada_is_array_descriptor_type (parent_type)
+      && TYPE_CODE (parent_type) == TYPE_CODE_TYPEDEF)
+    return 1;
+
+  if (TYPE_CODE (parent_type) == TYPE_CODE_ARRAY)
+    return ada_varobj_get_array_number_of_children (parent_value,
+                                                   parent_type);
+
+  if (TYPE_CODE (parent_type) == TYPE_CODE_STRUCT
+      || TYPE_CODE (parent_type) == TYPE_CODE_UNION)
+    return ada_varobj_get_struct_number_of_children (parent_value,
+                                                    parent_type);
+
+  if (TYPE_CODE (parent_type) == TYPE_CODE_PTR)
+    return ada_varobj_get_ptr_number_of_children (parent_value,
+                                                 parent_type);
+
+  /* All other types have no child.  */
+  return 0;
+}
+
+/* Describe the child of the (PARENT_VALUE, PARENT_TYPE) pair
+   whose index is CHILD_INDEX:
+
+     - If CHILD_NAME is not NULL, then a copy of the child's name
+       is saved in *CHILD_NAME.  This copy must be deallocated
+       with xfree after use.
+
+     - If CHILD_VALUE is not NULL, then save the child's value
+       in *CHILD_VALUE. Same thing for the child's type with
+       CHILD_TYPE if not NULL.
+
+     - If CHILD_PATH_EXPR is not NULL, then compute the child's
+       path expression.  The resulting string must be deallocated
+       after use with xfree.
+
+       Computing the child's path expression requires the PARENT_PATH_EXPR
+       to be non-NULL.  Otherwise, PARENT_PATH_EXPR may be null if
+       CHILD_PATH_EXPR is NULL.
+
+  PARENT_NAME is the name of the parent, and should never be NULL.  */
+
+static void ada_varobj_describe_child (struct value *parent_value,
+                                      struct type *parent_type,
+                                      const char *parent_name,
+                                      const char *parent_path_expr,
+                                      int child_index,
+                                      char **child_name,
+                                      struct value **child_value,
+                                      struct type **child_type,
+                                      char **child_path_expr);
+
+/* Same as ada_varobj_describe_child, but limited to struct/union
+   objects.  */
+
+static void
+ada_varobj_describe_struct_child (struct value *parent_value,
+                                 struct type *parent_type,
+                                 const char *parent_name,
+                                 const char *parent_path_expr,
+                                 int child_index,
+                                 char **child_name,
+                                 struct value **child_value,
+                                 struct type **child_type,
+                                 char **child_path_expr)
+{
+  int fieldno;
+  int childno = 0;
+
+  gdb_assert (TYPE_CODE (parent_type) == TYPE_CODE_STRUCT);
+
+  for (fieldno = 0; fieldno < TYPE_NFIELDS (parent_type); fieldno++)
+    {
+      if (ada_is_ignored_field (parent_type, fieldno))
+       continue;
+
+      if (ada_is_wrapper_field (parent_type, fieldno))
+       {
+         struct value *elt_value;
+         struct type *elt_type;
+         int elt_n_children;
+
+         ada_varobj_struct_elt (parent_value, parent_type, fieldno,
+                                &elt_value, &elt_type);
+         if (ada_is_tagged_type (elt_type, 0))
+           {
+             /* Same as in ada_varobj_get_struct_number_of_children:
+                For tagged types, we must be careful to not call
+                ada_varobj_get_number_of_children, to prevent our
+                element from being fixed back into the parent.  */
+             elt_n_children = ada_varobj_get_struct_number_of_children
+               (elt_value, elt_type);
+           }
+         else
+           elt_n_children =
+             ada_varobj_get_number_of_children (elt_value, elt_type);
+
+         /* Is the child we're looking for one of the children
+            of this wrapper field?  */
+         if (child_index - childno < elt_n_children)
+           {
+             if (ada_is_tagged_type (elt_type, 0))
+               {
+                 /* Same as in ada_varobj_get_struct_number_of_children:
+                    For tagged types, we must be careful to not call
+                    ada_varobj_describe_child, to prevent our element
+                    from being fixed back into the parent.  */
+                 ada_varobj_describe_struct_child
+                   (elt_value, elt_type, parent_name, parent_path_expr,
+                    child_index - childno, child_name, child_value,
+                    child_type, child_path_expr);
+               }
+             else
+               ada_varobj_describe_child (elt_value, elt_type,
+                                          parent_name, parent_path_expr,
+                                          child_index - childno,
+                                          child_name, child_value,
+                                          child_type, child_path_expr);
+             return;
+           }
+
+         /* The child we're looking for is beyond this wrapper
+            field, so skip all its children.  */
+         childno += elt_n_children;
+         continue;
+       }
+      else if (ada_is_variant_part (parent_type, fieldno))
+       {
+         /* In normal situations, the variant part of the record should
+            have been "fixed". Or, in other words, it should have been
+            replaced by the branch of the variant part that is relevant
+            for our value.  But there are still situations where this
+            can happen, however (Eg. when our parent is a NULL pointer).
+            We do not support showing this part of the record for now,
+            so just pretend this field does not exist.  */
+         continue;
+       }
+
+      if (childno == child_index)
+       {
+         if (child_name)
+           {
+             /* The name of the child is none other than the field's
+                name, except that we need to strip suffixes from it.
+                For instance, fields with alignment constraints will
+                have an __XVA suffix added to them.  */
+             const char *field_name = TYPE_FIELD_NAME (parent_type, fieldno);
+             int child_name_len = ada_name_prefix_len (field_name);
+
+             *child_name = xstrprintf ("%.*s", child_name_len, field_name);
+           }
+
+         if (child_value && parent_value)
+           ada_varobj_struct_elt (parent_value, parent_type, fieldno,
+                                  child_value, NULL);
+
+         if (child_type)
+           ada_varobj_struct_elt (parent_value, parent_type, fieldno,
+                                  NULL, child_type);
+
+         if (child_path_expr)
+           {
+             /* The name of the child is none other than the field's
+                name, except that we need to strip suffixes from it.
+                For instance, fields with alignment constraints will
+                have an __XVA suffix added to them.  */
+             const char *field_name = TYPE_FIELD_NAME (parent_type, fieldno);
+             int child_name_len = ada_name_prefix_len (field_name);
+
+             *child_path_expr =
+               xstrprintf ("(%s).%.*s", parent_path_expr,
+                           child_name_len, field_name);
+           }
+
+         return;
+       }
+
+      childno++;
+    }
+
+  /* Something went wrong.  Either we miscounted the number of
+     children, or CHILD_INDEX was too high.  But we should never
+     reach here.  We don't have enough information to recover
+     nicely, so just raise an assertion failure.  */
+  gdb_assert_not_reached ("unexpected code path");
+}
+
+/* Same as ada_varobj_describe_child, but limited to pointer objects.
+
+   Note that CHILD_INDEX is unused in this situation, but still provided
+   for consistency of interface with other routines describing an object's
+   child.  */
+
+static void
+ada_varobj_describe_ptr_child (struct value *parent_value,
+                              struct type *parent_type,
+                              const char *parent_name,
+                              const char *parent_path_expr,
+                              int child_index,
+                              char **child_name,
+                              struct value **child_value,
+                              struct type **child_type,
+                              char **child_path_expr)
+{
+  if (child_name)
+    *child_name = xstrprintf ("%s.all", parent_name);
+
+  if (child_value && parent_value)
+    ada_varobj_ind (parent_value, parent_type, child_value, NULL);
+
+  if (child_type)
+    ada_varobj_ind (parent_value, parent_type, NULL, child_type);
+
+  if (child_path_expr)
+    *child_path_expr = xstrprintf ("(%s).all", parent_path_expr);
+}
+
+/* Same as ada_varobj_describe_child, limited to simple array objects
+   (TYPE_CODE_ARRAY only).
+
+   Assumes that the (PARENT_VALUE, PARENT_TYPE) pair is properly decoded.
+   This is done by ada_varobj_describe_child before calling us.  */
+
+static void
+ada_varobj_describe_simple_array_child (struct value *parent_value,
+                                       struct type *parent_type,
+                                       const char *parent_name,
+                                       const char *parent_path_expr,
+                                       int child_index,
+                                       char **child_name,
+                                       struct value **child_value,
+                                       struct type **child_type,
+                                       char **child_path_expr)
+{
+  struct type *index_desc_type;
+  struct type *index_type;
+  int real_index;
+
+  gdb_assert (TYPE_CODE (parent_type) == TYPE_CODE_ARRAY);
+
+  index_desc_type = ada_find_parallel_type (parent_type, "___XA");
+  ada_fixup_array_indexes_type (index_desc_type);
+  if (index_desc_type)
+    index_type = TYPE_FIELD_TYPE (index_desc_type, 0);
+  else
+    index_type = TYPE_INDEX_TYPE (parent_type);
+  real_index = child_index + ada_discrete_type_low_bound (index_type);
+
+  if (child_name)
+    *child_name = ada_varobj_scalar_image (index_type, real_index);
+
+  if (child_value && parent_value)
+    ada_varobj_simple_array_elt (parent_value, parent_type, real_index,
+                                child_value, NULL);
+
+  if (child_type)
+    ada_varobj_simple_array_elt (parent_value, parent_type, real_index,
+                                NULL, child_type);
+
+  if (child_path_expr)
+    {
+      char *index_img = ada_varobj_scalar_image (index_type, real_index);
+      struct cleanup *cleanups = make_cleanup (xfree, index_img);
+
+      /* Enumeration litterals by themselves are potentially ambiguous.
+        For instance, consider the following package spec:
+
+           package Pck is
+              type Color is (Red, Green, Blue, White);
+              type Blood_Cells is (White, Red);
+           end Pck;
+
+        In this case, the litteral "red" for instance, or even
+        the fully-qualified litteral "pck.red" cannot be resolved
+        by itself.  Type qualification is needed to determine which
+        enumeration litterals should be used.
+
+        The following variable will be used to contain the name
+        of the array index type when such type qualification is
+        needed.  */
+      const char *index_type_name = NULL;
+
+      /* If the index type is a range type, find the base type.  */
+      while (TYPE_CODE (index_type) == TYPE_CODE_RANGE)
+       index_type = TYPE_TARGET_TYPE (index_type);
+
+      if (TYPE_CODE (index_type) == TYPE_CODE_ENUM
+         || TYPE_CODE (index_type) == TYPE_CODE_BOOL)
+       {
+         index_type_name = ada_type_name (index_type);
+         if (index_type_name)
+           index_type_name = ada_decode (index_type_name);
+       }
+
+      if (index_type_name != NULL)
+       *child_path_expr =
+         xstrprintf ("(%s)(%.*s'(%s))", parent_path_expr,
+                     ada_name_prefix_len (index_type_name),
+                     index_type_name, index_img);
+      else
+       *child_path_expr =
+         xstrprintf ("(%s)(%s)", parent_path_expr, index_img);
+      do_cleanups (cleanups);
+    }
+}
+
+/* See description at declaration above.  */
+
+static void
+ada_varobj_describe_child (struct value *parent_value,
+                          struct type *parent_type,
+                          const char *parent_name,
+                          const char *parent_path_expr,
+                          int child_index,
+                          char **child_name,
+                          struct value **child_value,
+                          struct type **child_type,
+                          char **child_path_expr)
+{
+  /* We cannot compute the child's path expression without
+     the parent's path expression.  This is a pre-condition
+     for calling this function.  */
+  if (child_path_expr)
+    gdb_assert (parent_path_expr != NULL);
+
+  ada_varobj_decode_var (&parent_value, &parent_type);
+  ada_varobj_adjust_for_child_access (&parent_value, &parent_type);
+
+  if (child_name)
+    *child_name = NULL;
+  if (child_value)
+    *child_value = NULL;
+  if (child_type)
+    *child_type = NULL;
+  if (child_path_expr)
+    *child_path_expr = NULL;
+
+  if (ada_is_array_descriptor_type (parent_type)
+      && TYPE_CODE (parent_type) == TYPE_CODE_TYPEDEF)
+    {
+      ada_varobj_describe_ptr_child (parent_value, parent_type,
+                                    parent_name, parent_path_expr,
+                                    child_index, child_name,
+                                    child_value, child_type,
+                                    child_path_expr);
+      return;
+    }
+
+  if (TYPE_CODE (parent_type) == TYPE_CODE_ARRAY)
+    {
+      ada_varobj_describe_simple_array_child
+       (parent_value, parent_type, parent_name, parent_path_expr,
+        child_index, child_name, child_value, child_type,
+        child_path_expr);
+      return;
+    }
+
+  if (TYPE_CODE (parent_type) == TYPE_CODE_STRUCT)
+    {
+      ada_varobj_describe_struct_child (parent_value, parent_type,
+                                       parent_name, parent_path_expr,
+                                       child_index, child_name,
+                                       child_value, child_type,
+                                       child_path_expr);
+      return;
+    }
+
+  if (TYPE_CODE (parent_type) == TYPE_CODE_PTR)
+    {
+      ada_varobj_describe_ptr_child (parent_value, parent_type,
+                                    parent_name, parent_path_expr,
+                                    child_index, child_name,
+                                    child_value, child_type,
+                                    child_path_expr);
+      return;
+    }
+
+  /* It should never happen.  But rather than crash, report dummy names
+     and return a NULL child_value.  */
+  if (child_name)
+    *child_name = xstrdup ("???");
+}
+
+/* Return the name of the child number CHILD_INDEX of the (PARENT_VALUE,
+   PARENT_TYPE) pair.  PARENT_NAME is the name of the PARENT.
+
+   The result should be deallocated after use with xfree.  */
+
+char *
+ada_varobj_get_name_of_child (struct value *parent_value,
+                             struct type *parent_type,
+                             const char *parent_name, int child_index)
+{
+  char *child_name;
+
+  ada_varobj_describe_child (parent_value, parent_type, parent_name,
+                            NULL, child_index, &child_name, NULL,
+                            NULL, NULL);
+  return child_name;
+}
+
+/* Return the path expression of the child number CHILD_INDEX of
+   the (PARENT_VALUE, PARENT_TYPE) pair.  PARENT_NAME is the name
+   of the parent, and PARENT_PATH_EXPR is the parent's path expression.
+   Both must be non-NULL.
+
+   The result must be deallocated after use with xfree.  */
+
+char *
+ada_varobj_get_path_expr_of_child (struct value *parent_value,
+                                  struct type *parent_type,
+                                  const char *parent_name,
+                                  const char *parent_path_expr,
+                                  int child_index)
+{
+  char *child_path_expr;
+
+  ada_varobj_describe_child (parent_value, parent_type, parent_name,
+                            parent_path_expr, child_index, NULL,
+                            NULL, NULL, &child_path_expr);
+
+  return child_path_expr;
+}
+
+/* Return the value of child number CHILD_INDEX of the (PARENT_VALUE,
+   PARENT_TYPE) pair.  PARENT_NAME is the name of the parent.  */
+
+struct value *
+ada_varobj_get_value_of_child (struct value *parent_value,
+                              struct type *parent_type,
+                              const char *parent_name, int child_index)
+{
+  struct value *child_value;
+
+  ada_varobj_describe_child (parent_value, parent_type, parent_name,
+                            NULL, child_index, NULL, &child_value,
+                            NULL, NULL);
+
+  return child_value;
+}
+
+/* Return the type of child number CHILD_INDEX of the (PARENT_VALUE,
+   PARENT_TYPE) pair.  */
+
+struct type *
+ada_varobj_get_type_of_child (struct value *parent_value,
+                             struct type *parent_type,
+                             int child_index)
+{
+  struct type *child_type;
+
+  ada_varobj_describe_child (parent_value, parent_type, NULL, NULL,
+                            child_index, NULL, NULL, &child_type, NULL);
+
+  return child_type;
+}
+
+/* Return a string that contains the image of the given VALUE, using
+   the print options OPTS as the options for formatting the result.
+
+   The resulting string must be deallocated after use with xfree.  */
+
+static char *
+ada_varobj_get_value_image (struct value *value,
+                           struct value_print_options *opts)
+{
+  char *result;
+  struct ui_file *buffer;
+  struct cleanup *old_chain;
+
+  buffer = mem_fileopen ();
+  old_chain = make_cleanup_ui_file_delete (buffer);
+
+  common_val_print (value, buffer, 0, opts, current_language);
+  result = ui_file_xstrdup (buffer, NULL);
+
+  do_cleanups (old_chain);
+  return result;
+}
+
+/* Assuming that the (VALUE, TYPE) pair designates an array varobj,
+   return a string that is suitable for use in the "value" field of
+   the varobj output.  Most of the time, this is the number of elements
+   in the array inside square brackets, but there are situations where
+   it's useful to add more info.
+
+   OPTS are the print options used when formatting the result.
+
+   The result should be deallocated after use using xfree.  */
+
+static char *
+ada_varobj_get_value_of_array_variable (struct value *value,
+                                       struct type *type,
+                                       struct value_print_options *opts)
+{
+  char *result;
+  const int numchild = ada_varobj_get_array_number_of_children (value, type);
+
+  /* If we have a string, provide its contents in the "value" field.
+     Otherwise, the only other way to inspect the contents of the string
+     is by looking at the value of each element, as in any other array,
+     which is not very convenient...  */
+  if (value
+      && ada_is_string_type (type)
+      && (opts->format == 0 || opts->format == 's'))
+    {
+      char *str;
+      struct cleanup *old_chain;
+
+      str = ada_varobj_get_value_image (value, opts);
+      old_chain = make_cleanup (xfree, str);
+      result = xstrprintf ("[%d] %s", numchild, str);
+      do_cleanups (old_chain);
+    }
+  else
+    result = xstrprintf ("[%d]", numchild);
+
+  return result;
+}
+
+/* Return a string representation of the (VALUE, TYPE) pair, using
+   the given print options OPTS as our formatting options.  */
+
+char *
+ada_varobj_get_value_of_variable (struct value *value,
+                                 struct type *type,
+                                 struct value_print_options *opts)
+{
+  char *result = NULL;
+
+  ada_varobj_decode_var (&value, &type);
+
+  switch (TYPE_CODE (type))
+    {
+    case TYPE_CODE_STRUCT:
+    case TYPE_CODE_UNION:
+      result = xstrdup ("{...}");
+      break;
+    case TYPE_CODE_ARRAY:
+      result = ada_varobj_get_value_of_array_variable (value, type, opts);
+      break;
+    default:
+      if (!value)
+       result = xstrdup ("");
+      else
+       result = ada_varobj_get_value_image (value, opts);
+      break;
+    }
+
+  return result;
+}
+
+
diff --git a/gdb/ada-varobj.h b/gdb/ada-varobj.h
new file mode 100644 (file)
index 0000000..2ef1a70
--- /dev/null
@@ -0,0 +1,56 @@
+/* varobj support for Ada.
+
+   Copyright (C) 2012 Free Software Foundation, Inc.
+
+   This file is part of GDB.
+
+   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/>.  */
+
+#ifndef ADA_VAROBJ_H
+#define ADA_VAROBJ_H
+
+#include "defs.h"
+#include "varobj.h"
+
+struct value;
+struct value_print_options;
+
+extern int ada_varobj_get_number_of_children (struct value *parent_value,
+                                             struct type *parent_type);
+
+extern char *ada_varobj_get_name_of_child (struct value *parent_value,
+                                          struct type *parent_type,
+                                          const char *parent_name,
+                                          int child_index);
+
+extern char *ada_varobj_get_path_expr_of_child (struct value *parent_value,
+                                               struct type *parent_type,
+                                               const char *parent_name,
+                                               const char *parent_path_expr,
+                                               int child_index);
+
+extern struct value *ada_varobj_get_value_of_child (struct value *parent_value,
+                                                   struct type *parent_type,
+                                                   const char *parent_name,
+                                                   int child_index);
+
+extern struct type *ada_varobj_get_type_of_child (struct value *parent_value,
+                                                 struct type *parent_type,
+                                                 int child_index);
+
+extern char *ada_varobj_get_value_of_variable
+  (struct value *value, struct type *type,
+   struct value_print_options *opts);
+
+#endif /* ADA_VAROBJ_H */
index d1b5c33..aaea238 100644 (file)
@@ -33,6 +33,8 @@
 #include "vec.h"
 #include "gdbthread.h"
 #include "inferior.h"
+#include "ada-varobj.h"
+#include "ada-lang.h"
 
 #if HAVE_PYTHON
 #include "python/python.h"
@@ -2921,6 +2923,29 @@ varobj_value_is_changeable_p (struct varobj *var)
   if (CPLUS_FAKE_CHILD (var))
     return 0;
 
+  /* FIXME: This, and the check above, show that this routine
+     should be language-specific.  */
+  if (variable_language (var) == vlang_ada)
+    {
+      struct type *type = var->value ? value_type (var->value) : var->type;
+
+      if (ada_is_array_descriptor_type (type)
+         && TYPE_CODE (type) == TYPE_CODE_TYPEDEF)
+       {
+         /* This is in reality a pointer to an unconstrained array.
+            its value is changeable.  */
+         return 1;
+       }
+
+      if (ada_is_string_type (type))
+       {
+         /* We display the contents of the string in the array's
+            "value" field.  The contents can change, so consider
+            that the array is changeable.  */
+         return 1;
+       }
+    }
+
   type = get_value_type (var);
 
   switch (TYPE_CODE (type))
@@ -3881,7 +3906,7 @@ java_value_of_variable (struct varobj *var, enum varobj_display_formats format)
 static int
 ada_number_of_children (struct varobj *var)
 {
-  return c_number_of_children (var);
+  return ada_varobj_get_number_of_children (var->value, var->type);
 }
 
 static char *
@@ -3893,13 +3918,21 @@ ada_name_of_variable (struct varobj *parent)
 static char *
 ada_name_of_child (struct varobj *parent, int index)
 {
-  return c_name_of_child (parent, index);
+  return ada_varobj_get_name_of_child (parent->value, parent->type,
+                                      parent->name, index);
 }
 
 static char*
 ada_path_expr_of_child (struct varobj *child)
 {
-  return c_path_expr_of_child (child);
+  struct varobj *parent = child->parent;
+  const char *parent_path_expr = varobj_get_path_expr (parent);
+
+  return ada_varobj_get_path_expr_of_child (parent->value,
+                                           parent->type,
+                                           parent->name,
+                                           parent_path_expr,
+                                           child->index);
 }
 
 static struct value *
@@ -3911,19 +3944,27 @@ ada_value_of_root (struct varobj **var_handle)
 static struct value *
 ada_value_of_child (struct varobj *parent, int index)
 {
-  return c_value_of_child (parent, index);
+  return ada_varobj_get_value_of_child (parent->value, parent->type,
+                                       parent->name, index);
 }
 
 static struct type *
 ada_type_of_child (struct varobj *parent, int index)
 {
-  return c_type_of_child (parent, index);
+  return ada_varobj_get_type_of_child (parent->value, parent->type,
+                                      index);
 }
 
 static char *
 ada_value_of_variable (struct varobj *var, enum varobj_display_formats format)
 {
-  return c_value_of_variable (var, format);
+  struct value_print_options opts;
+
+  get_formatted_print_options (&opts, format_code[(int) format]);
+  opts.deref_ref = 0;
+  opts.raw = 1;
+
+  return ada_varobj_get_value_of_variable (var->value, var->type, &opts);
 }
 
 /* Implement the "value_has_mutated" routine for Ada.  */
@@ -3932,7 +3973,36 @@ static int
 ada_value_has_mutated (struct varobj *var, struct value *new_val,
                       struct type *new_type)
 {
-  /* Unimplemented for now.  */
+  int i;
+  int from = -1;
+  int to = -1;
+
+  /* If the number of fields have changed, then for sure the type
+     has mutated.  */
+  if (ada_varobj_get_number_of_children (new_val, new_type)
+      != var->num_children)
+    return 1;
+
+  /* If the number of fields have remained the same, then we need
+     to check the name of each field.  If they remain the same,
+     then chances are the type hasn't mutated.  This is technically
+     an incomplete test, as the child's type might have changed
+     despite the fact that the name remains the same.  But we'll
+     handle this situation by saying that the child has mutated,
+     not this value.
+
+     If only part (or none!) of the children have been fetched,
+     then only check the ones we fetched.  It does not matter
+     to the frontend whether a child that it has not fetched yet
+     has mutated or not. So just assume it hasn't.  */
+
+  restrict_range (var->children, &from, &to);
+  for (i = from; i < to; i++)
+    if (strcmp (ada_varobj_get_name_of_child (new_val, new_type,
+                                             var->name, i),
+               VEC_index (varobj_p, var->children, i)->name) != 0)
+      return 1;
+
   return 0;
 }