From 181875a4ab05b144b16271677cdfcac85edd5c7e Mon Sep 17 00:00:00 2001 From: Joel Brobecker Date: Wed, 28 Mar 2012 21:31:18 +0000 Subject: [PATCH] Varobj support for Ada. 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 | 7 + gdb/Makefile.in | 5 +- gdb/ada-varobj.c | 889 +++++++++++++++++++++++++++++++++++++++++++++++ gdb/ada-varobj.h | 56 +++ gdb/varobj.c | 84 ++++- 5 files changed, 1032 insertions(+), 9 deletions(-) create mode 100644 gdb/ada-varobj.c create mode 100644 gdb/ada-varobj.h diff --git a/gdb/ChangeLog b/gdb/ChangeLog index 7eeae6db6ca..489057840e7 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,10 @@ +2012-03-28 Joel Brobecker + + * 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 * varobj.c (ada_value_has_mutated): Add declaration. New function. diff --git a/gdb/Makefile.in b/gdb/Makefile.in index 4d856624552..44d76f23a72 100644 --- a/gdb/Makefile.in +++ b/gdb/Makefile.in @@ -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 index 00000000000..31f80f52c5d --- /dev/null +++ b/gdb/ada-varobj.c @@ -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 . */ + +#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 index 00000000000..2ef1a70c174 --- /dev/null +++ b/gdb/ada-varobj.h @@ -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 . */ + +#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 */ diff --git a/gdb/varobj.c b/gdb/varobj.c index d1b5c33f188..aaea23861d8 100644 --- a/gdb/varobj.c +++ b/gdb/varobj.c @@ -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; } -- 2.30.2