gdb/ada-varobj.c

   1 /* varobj support for Ada.
   2
   3    Copyright (C) 2012-2013 Free Software Foundation, Inc.
   4
   5    This file is part of GDB.
   6
   7    This program is free software; you can redistribute it and/or modify
   8    it under the terms of the GNU General Public License as published by
   9    the Free Software Foundation; either version 3 of the License, or
  10    (at your option) any later version.
  11
  12    This program is distributed in the hope that it will be useful,
  13    but WITHOUT ANY WARRANTY; without even the implied warranty of
  14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15    GNU General Public License for more details.
  16
  17    You should have received a copy of the GNU General Public License
  18    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
  19
  20 #include "defs.h"
  21 #include "ada-lang.h"
  22 #include "varobj.h"
  23 #include "language.h"
  24 #include "valprint.h"
  25
  26 /* Implementation principle used in this unit:
  27
  28    For our purposes, the meat of the varobj object is made of two
  29    elements: The varobj's (struct) value, and the varobj's (struct)
  30    type.  In most situations, the varobj has a non-NULL value, and
  31    the type becomes redundant, as it can be directly derived from
  32    the value.  In the initial implementation of this unit, most
  33    routines would only take a value, and return a value.
  34
  35    But there are many situations where it is possible for a varobj
  36    to have a NULL value.  For instance, if the varobj becomes out of
  37    scope.  Or better yet, when the varobj is the child of another
  38    NULL pointer varobj.  In that situation, we must rely on the type
  39    instead of the value to create the child varobj.
  40
  41    That's why most functions below work with a (value, type) pair.
  42    The value may or may not be NULL.  But the type is always expected
  43    to be set.  When the value is NULL, then we work with the type
  44    alone, and keep the value NULL.  But when the value is not NULL,
  45    then we work using the value, because it provides more information.
  46    But we still always set the type as well, even if that type could
  47    easily be derived from the value.  The reason behind this is that
  48    it allows the code to use the type without having to worry about
  49    it being set or not.  It makes the code clearer.  */
  50
  51 static int ada_varobj_get_number_of_children (struct value *parent_value,
  52                                               struct type *parent_type);
  53
  54 /* A convenience function that decodes the VALUE_PTR/TYPE_PTR couple:
  55    If there is a value (*VALUE_PTR not NULL), then perform the decoding
  56    using it, and compute the associated type from the resulting value.
  57    Otherwise, compute a static approximation of *TYPE_PTR, leaving
  58    *VALUE_PTR unchanged.
  59
  60    The results are written in place.  */
  61
  62 static void
  63 ada_varobj_decode_var (struct value **value_ptr, struct type **type_ptr)
  64 {
  65   if (*value_ptr)
  66     {
  67       *value_ptr = ada_get_decoded_value (*value_ptr);
  68       *type_ptr = ada_check_typedef (value_type (*value_ptr));
  69     }
  70   else
  71     *type_ptr = ada_get_decoded_type (*type_ptr);
  72 }
  73
  74 /* Return a string containing an image of the given scalar value.
  75    VAL is the numeric value, while TYPE is the value's type.
  76    This is useful for plain integers, of course, but even more
  77    so for enumerated types.
  78
  79    The result should be deallocated by xfree after use.  */
  80
  81 static char *
  82 ada_varobj_scalar_image (struct type *type, LONGEST val)
  83 {
  84   struct ui_file *buf = mem_fileopen ();
  85   struct cleanup *cleanups = make_cleanup_ui_file_delete (buf);
  86   char *result;
  87
  88   ada_print_scalar (type, val, buf);
  89   result = ui_file_xstrdup (buf, NULL);
  90   do_cleanups (cleanups);
  91
  92   return result;
  93 }
  94
  95 /* Assuming that the (PARENT_VALUE, PARENT_TYPE) pair designates
  96    a struct or union, compute the (CHILD_VALUE, CHILD_TYPE) couple
  97    corresponding to the field number FIELDNO.  */
  98
  99 static void
 100 ada_varobj_struct_elt (struct value *parent_value,
 101                        struct type *parent_type,
 102                        int fieldno,
 103                        struct value **child_value,
 104                        struct type **child_type)
 105 {
 106   struct value *value = NULL;
 107   struct type *type = NULL;
 108
 109   if (parent_value)
 110     {
 111       value = value_field (parent_value, fieldno);
 112       type = value_type (value);
 113     }
 114   else
 115     type = TYPE_FIELD_TYPE (parent_type, fieldno);
 116
 117   if (child_value)
 118     *child_value = value;
 119   if (child_type)
 120     *child_type = type;
 121 }
 122
 123 /* Assuming that the (PARENT_VALUE, PARENT_TYPE) pair is a pointer or
 124    reference, return a (CHILD_VALUE, CHILD_TYPE) couple corresponding
 125    to the dereferenced value.  */
 126
 127 static void
 128 ada_varobj_ind (struct value *parent_value,
 129                 struct type *parent_type,
 130                 struct value **child_value,
 131                 struct type **child_type)
 132 {
 133   struct value *value = NULL;
 134   struct type *type = NULL;
 135
 136   if (ada_is_array_descriptor_type (parent_type))
 137     {
 138       /* This can only happen when PARENT_VALUE is NULL.  Otherwise,
 139          ada_get_decoded_value would have transformed our parent_type
 140          into a simple array pointer type.  */
 141       gdb_assert (parent_value == NULL);
 142       gdb_assert (TYPE_CODE (parent_type) == TYPE_CODE_TYPEDEF);
 143
 144       /* Decode parent_type by the equivalent pointer to (decoded)
 145          array.  */
 146       while (TYPE_CODE (parent_type) == TYPE_CODE_TYPEDEF)
 147         parent_type = TYPE_TARGET_TYPE (parent_type);
 148       parent_type = ada_coerce_to_simple_array_type (parent_type);
 149       parent_type = lookup_pointer_type (parent_type);
 150     }
 151
 152   /* If parent_value is a null pointer, then only perform static
 153      dereferencing.  We cannot dereference null pointers.  */
 154   if (parent_value && value_as_address (parent_value) == 0)
 155     parent_value = NULL;
 156
 157   if (parent_value)
 158     {
 159       value = ada_value_ind (parent_value);
 160       type = value_type (value);
 161     }
 162   else
 163     type = TYPE_TARGET_TYPE (parent_type);
 164
 165   if (child_value)
 166     *child_value = value;
 167   if (child_type)
 168     *child_type = type;
 169 }
 170
 171 /* Assuming that the (PARENT_VALUE, PARENT_TYPE) pair is a simple
 172    array (TYPE_CODE_ARRAY), return the (CHILD_VALUE, CHILD_TYPE)
 173    pair corresponding to the element at ELT_INDEX.  */
 174
 175 static void
 176 ada_varobj_simple_array_elt (struct value *parent_value,
 177                              struct type *parent_type,
 178                              int elt_index,
 179                              struct value **child_value,
 180                              struct type **child_type)
 181 {
 182   struct value *value = NULL;
 183   struct type *type = NULL;
 184
 185   if (parent_value)
 186     {
 187       struct value *index_value =
 188         value_from_longest (TYPE_INDEX_TYPE (parent_type), elt_index);
 189
 190       value = ada_value_subscript (parent_value, 1, &index_value);
 191       type = value_type (value);
 192     }
 193   else
 194     type = TYPE_TARGET_TYPE (parent_type);
 195
 196   if (child_value)
 197     *child_value = value;
 198   if (child_type)
 199     *child_type = type;
 200 }
 201
 202 /* Given the decoded value and decoded type of a variable object,
 203    adjust the value and type to those necessary for getting children
 204    of the variable object.
 205
 206    The replacement is performed in place.  */
 207
 208 static void
 209 ada_varobj_adjust_for_child_access (struct value **value,
 210                                     struct type **type)
 211 {
 212    /* Pointers to struct/union types are special: Instead of having
 213       one child (the struct), their children are the components of
 214       the struct/union type.  We handle this situation by dereferencing
 215       the (value, type) couple.  */
 216   if (TYPE_CODE (*type) == TYPE_CODE_PTR
 217       && (TYPE_CODE (TYPE_TARGET_TYPE (*type)) == TYPE_CODE_STRUCT
 218           || TYPE_CODE (TYPE_TARGET_TYPE (*type)) == TYPE_CODE_UNION)
 219       && !ada_is_array_descriptor_type (TYPE_TARGET_TYPE (*type))
 220       && !ada_is_constrained_packed_array_type (TYPE_TARGET_TYPE (*type)))
 221     ada_varobj_ind (*value, *type, value, type);
 222 }
 223
 224 /* Assuming that the (PARENT_VALUE, PARENT_TYPE) pair is an array
 225    (any type of array, "simple" or not), return the number of children
 226    that this array contains.  */
 227
 228 static int
 229 ada_varobj_get_array_number_of_children (struct value *parent_value,
 230                                          struct type *parent_type)
 231 {
 232   LONGEST lo, hi;
 233
 234   if (!get_array_bounds (parent_type, &lo, &hi))
 235     {
 236       /* Could not get the array bounds.  Pretend this is an empty array.  */
 237       warning (_("unable to get bounds of array, assuming null array"));
 238       return 0;
 239     }
 240
 241   /* Ada allows the upper bound to be less than the lower bound,
 242      in order to specify empty arrays...  */
 243   if (hi < lo)
 244     return 0;
 245
 246   return hi - lo + 1;
 247 }
 248
 249 /* Assuming that the (PARENT_VALUE, PARENT_TYPE) pair is a struct or
 250    union, return the number of children this struct contains.  */
 251
 252 static int
 253 ada_varobj_get_struct_number_of_children (struct value *parent_value,
 254                                           struct type *parent_type)
 255 {
 256   int n_children = 0;
 257   int i;
 258
 259   gdb_assert (TYPE_CODE (parent_type) == TYPE_CODE_STRUCT
 260               || TYPE_CODE (parent_type) == TYPE_CODE_UNION);
 261
 262   for (i = 0; i < TYPE_NFIELDS (parent_type); i++)
 263     {
 264       if (ada_is_ignored_field (parent_type, i))
 265         continue;
 266
 267       if (ada_is_wrapper_field (parent_type, i))
 268         {
 269           struct value *elt_value;
 270           struct type *elt_type;
 271
 272           ada_varobj_struct_elt (parent_value, parent_type, i,
 273                                  &elt_value, &elt_type);
 274           if (ada_is_tagged_type (elt_type, 0))
 275             {
 276               /* We must not use ada_varobj_get_number_of_children
 277                  to determine is element's number of children, because
 278                  this function first calls ada_varobj_decode_var,
 279                  which "fixes" the element.  For tagged types, this
 280                  includes reading the object's tag to determine its
 281                  real type, which happens to be the parent_type, and
 282                  leads to an infinite loop (because the element gets
 283                  fixed back into the parent).  */
 284               n_children += ada_varobj_get_struct_number_of_children
 285                 (elt_value, elt_type);
 286             }
 287           else
 288             n_children += ada_varobj_get_number_of_children (elt_value, elt_type);
 289         }
 290       else if (ada_is_variant_part (parent_type, i))
 291         {
 292           /* In normal situations, the variant part of the record should
 293              have been "fixed". Or, in other words, it should have been
 294              replaced by the branch of the variant part that is relevant
 295              for our value.  But there are still situations where this
 296              can happen, however (Eg. when our parent is a NULL pointer).
 297              We do not support showing this part of the record for now,
 298              so just pretend this field does not exist.  */
 299         }
 300       else
 301         n_children++;
 302     }
 303
 304   return n_children;
 305 }
 306
 307 /* Assuming that the (PARENT_VALUE, PARENT_TYPE) pair designates
 308    a pointer, return the number of children this pointer has.  */
 309
 310 static int
 311 ada_varobj_get_ptr_number_of_children (struct value *parent_value,
 312                                        struct type *parent_type)
 313 {
 314   struct type *child_type = TYPE_TARGET_TYPE (parent_type);
 315
 316   /* Pointer to functions and to void do not have a child, since
 317      you cannot print what they point to.  */
 318   if (TYPE_CODE (child_type) == TYPE_CODE_FUNC
 319       || TYPE_CODE (child_type) == TYPE_CODE_VOID)
 320     return 0;
 321
 322   /* All other types have 1 child.  */
 323   return 1;
 324 }
 325
 326 /* Return the number of children for the (PARENT_VALUE, PARENT_TYPE)
 327    pair.  */
 328
 329 static int
 330 ada_varobj_get_number_of_children (struct value *parent_value,
 331                                    struct type *parent_type)
 332 {
 333   ada_varobj_decode_var (&parent_value, &parent_type);
 334   ada_varobj_adjust_for_child_access (&parent_value, &parent_type);
 335
 336   /* A typedef to an array descriptor in fact represents a pointer
 337      to an unconstrained array.  These types always have one child
 338      (the unconstrained array).  */
 339   if (ada_is_array_descriptor_type (parent_type)
 340       && TYPE_CODE (parent_type) == TYPE_CODE_TYPEDEF)
 341     return 1;
 342
 343   if (TYPE_CODE (parent_type) == TYPE_CODE_ARRAY)
 344     return ada_varobj_get_array_number_of_children (parent_value,
 345                                                     parent_type);
 346
 347   if (TYPE_CODE (parent_type) == TYPE_CODE_STRUCT
 348       || TYPE_CODE (parent_type) == TYPE_CODE_UNION)
 349     return ada_varobj_get_struct_number_of_children (parent_value,
 350                                                      parent_type);
 351
 352   if (TYPE_CODE (parent_type) == TYPE_CODE_PTR)
 353     return ada_varobj_get_ptr_number_of_children (parent_value,
 354                                                   parent_type);
 355
 356   /* All other types have no child.  */
 357   return 0;
 358 }
 359
 360 /* Describe the child of the (PARENT_VALUE, PARENT_TYPE) pair
 361    whose index is CHILD_INDEX:
 362
 363      - If CHILD_NAME is not NULL, then a copy of the child's name
 364        is saved in *CHILD_NAME.  This copy must be deallocated
 365        with xfree after use.
 366
 367      - If CHILD_VALUE is not NULL, then save the child's value
 368        in *CHILD_VALUE. Same thing for the child's type with
 369        CHILD_TYPE if not NULL.
 370
 371      - If CHILD_PATH_EXPR is not NULL, then compute the child's
 372        path expression.  The resulting string must be deallocated
 373        after use with xfree.
 374
 375        Computing the child's path expression requires the PARENT_PATH_EXPR
 376        to be non-NULL.  Otherwise, PARENT_PATH_EXPR may be null if
 377        CHILD_PATH_EXPR is NULL.
 378
 379   PARENT_NAME is the name of the parent, and should never be NULL.  */
 380
 381 static void ada_varobj_describe_child (struct value *parent_value,
 382                                        struct type *parent_type,
 383                                        const char *parent_name,
 384                                        const char *parent_path_expr,
 385                                        int child_index,
 386                                        char **child_name,
 387                                        struct value **child_value,
 388                                        struct type **child_type,
 389                                        char **child_path_expr);
 390
 391 /* Same as ada_varobj_describe_child, but limited to struct/union
 392    objects.  */
 393
 394 static void
 395 ada_varobj_describe_struct_child (struct value *parent_value,
 396                                   struct type *parent_type,
 397                                   const char *parent_name,
 398                                   const char *parent_path_expr,
 399                                   int child_index,
 400                                   char **child_name,
 401                                   struct value **child_value,
 402                                   struct type **child_type,
 403                                   char **child_path_expr)
 404 {
 405   int fieldno;
 406   int childno = 0;
 407
 408   gdb_assert (TYPE_CODE (parent_type) == TYPE_CODE_STRUCT);
 409
 410   for (fieldno = 0; fieldno < TYPE_NFIELDS (parent_type); fieldno++)
 411     {
 412       if (ada_is_ignored_field (parent_type, fieldno))
 413         continue;
 414
 415       if (ada_is_wrapper_field (parent_type, fieldno))
 416         {
 417           struct value *elt_value;
 418           struct type *elt_type;
 419           int elt_n_children;
 420
 421           ada_varobj_struct_elt (parent_value, parent_type, fieldno,
 422                                  &elt_value, &elt_type);
 423           if (ada_is_tagged_type (elt_type, 0))
 424             {
 425               /* Same as in ada_varobj_get_struct_number_of_children:
 426                  For tagged types, we must be careful to not call
 427                  ada_varobj_get_number_of_children, to prevent our
 428                  element from being fixed back into the parent.  */
 429               elt_n_children = ada_varobj_get_struct_number_of_children
 430                 (elt_value, elt_type);
 431             }
 432           else
 433             elt_n_children =
 434               ada_varobj_get_number_of_children (elt_value, elt_type);
 435
 436           /* Is the child we're looking for one of the children
 437              of this wrapper field?  */
 438           if (child_index - childno < elt_n_children)
 439             {
 440               if (ada_is_tagged_type (elt_type, 0))
 441                 {
 442                   /* Same as in ada_varobj_get_struct_number_of_children:
 443                      For tagged types, we must be careful to not call
 444                      ada_varobj_describe_child, to prevent our element
 445                      from being fixed back into the parent.  */
 446                   ada_varobj_describe_struct_child
 447                     (elt_value, elt_type, parent_name, parent_path_expr,
 448                      child_index - childno, child_name, child_value,
 449                      child_type, child_path_expr);
 450                 }
 451               else
 452                 ada_varobj_describe_child (elt_value, elt_type,
 453                                            parent_name, parent_path_expr,
 454                                            child_index - childno,
 455                                            child_name, child_value,
 456                                            child_type, child_path_expr);
 457               return;
 458             }
 459
 460           /* The child we're looking for is beyond this wrapper
 461              field, so skip all its children.  */
 462           childno += elt_n_children;
 463           continue;
 464         }
 465       else if (ada_is_variant_part (parent_type, fieldno))
 466         {
 467           /* In normal situations, the variant part of the record should
 468              have been "fixed". Or, in other words, it should have been
 469              replaced by the branch of the variant part that is relevant
 470              for our value.  But there are still situations where this
 471              can happen, however (Eg. when our parent is a NULL pointer).
 472              We do not support showing this part of the record for now,
 473              so just pretend this field does not exist.  */
 474           continue;
 475         }
 476
 477       if (childno == child_index)
 478         {
 479           if (child_name)
 480             {
 481               /* The name of the child is none other than the field's
 482                  name, except that we need to strip suffixes from it.
 483                  For instance, fields with alignment constraints will
 484                  have an __XVA suffix added to them.  */
 485               const char *field_name = TYPE_FIELD_NAME (parent_type, fieldno);
 486               int child_name_len = ada_name_prefix_len (field_name);
 487
 488               *child_name = xstrprintf ("%.*s", child_name_len, field_name);
 489             }
 490
 491           if (child_value && parent_value)
 492             ada_varobj_struct_elt (parent_value, parent_type, fieldno,
 493                                    child_value, NULL);
 494
 495           if (child_type)
 496             ada_varobj_struct_elt (parent_value, parent_type, fieldno,
 497                                    NULL, child_type);
 498
 499           if (child_path_expr)
 500             {
 501               /* The name of the child is none other than the field's
 502                  name, except that we need to strip suffixes from it.
 503                  For instance, fields with alignment constraints will
 504                  have an __XVA suffix added to them.  */
 505               const char *field_name = TYPE_FIELD_NAME (parent_type, fieldno);
 506               int child_name_len = ada_name_prefix_len (field_name);
 507
 508               *child_path_expr =
 509                 xstrprintf ("(%s).%.*s", parent_path_expr,
 510                             child_name_len, field_name);
 511             }
 512
 513           return;
 514         }
 515
 516       childno++;
 517     }
 518
 519   /* Something went wrong.  Either we miscounted the number of
 520      children, or CHILD_INDEX was too high.  But we should never
 521      reach here.  We don't have enough information to recover
 522      nicely, so just raise an assertion failure.  */
 523   gdb_assert_not_reached ("unexpected code path");
 524 }
 525
 526 /* Same as ada_varobj_describe_child, but limited to pointer objects.
 527
 528    Note that CHILD_INDEX is unused in this situation, but still provided
 529    for consistency of interface with other routines describing an object's
 530    child.  */
 531
 532 static void
 533 ada_varobj_describe_ptr_child (struct value *parent_value,
 534                                struct type *parent_type,
 535                                const char *parent_name,
 536                                const char *parent_path_expr,
 537                                int child_index,
 538                                char **child_name,
 539                                struct value **child_value,
 540                                struct type **child_type,
 541                                char **child_path_expr)
 542 {
 543   if (child_name)
 544     *child_name = xstrprintf ("%s.all", parent_name);
 545
 546   if (child_value && parent_value)
 547     ada_varobj_ind (parent_value, parent_type, child_value, NULL);
 548
 549   if (child_type)
 550     ada_varobj_ind (parent_value, parent_type, NULL, child_type);
 551
 552   if (child_path_expr)
 553     *child_path_expr = xstrprintf ("(%s).all", parent_path_expr);
 554 }
 555
 556 /* Same as ada_varobj_describe_child, limited to simple array objects
 557    (TYPE_CODE_ARRAY only).
 558
 559    Assumes that the (PARENT_VALUE, PARENT_TYPE) pair is properly decoded.
 560    This is done by ada_varobj_describe_child before calling us.  */
 561
 562 static void
 563 ada_varobj_describe_simple_array_child (struct value *parent_value,
 564                                         struct type *parent_type,
 565                                         const char *parent_name,
 566                                         const char *parent_path_expr,
 567                                         int child_index,
 568                                         char **child_name,
 569                                         struct value **child_value,
 570                                         struct type **child_type,
 571                                         char **child_path_expr)
 572 {
 573   struct type *index_desc_type;
 574   struct type *index_type;
 575   int real_index;
 576
 577   gdb_assert (TYPE_CODE (parent_type) == TYPE_CODE_ARRAY);
 578
 579   index_desc_type = ada_find_parallel_type (parent_type, "___XA");
 580   ada_fixup_array_indexes_type (index_desc_type);
 581   if (index_desc_type)
 582     index_type = TYPE_FIELD_TYPE (index_desc_type, 0);
 583   else
 584     index_type = TYPE_INDEX_TYPE (parent_type);
 585   real_index = child_index + ada_discrete_type_low_bound (index_type);
 586
 587   if (child_name)
 588     *child_name = ada_varobj_scalar_image (index_type, real_index);
 589
 590   if (child_value && parent_value)
 591     ada_varobj_simple_array_elt (parent_value, parent_type, real_index,
 592                                  child_value, NULL);
 593
 594   if (child_type)
 595     ada_varobj_simple_array_elt (parent_value, parent_type, real_index,
 596                                  NULL, child_type);
 597
 598   if (child_path_expr)
 599     {
 600       char *index_img = ada_varobj_scalar_image (index_type, real_index);
 601       struct cleanup *cleanups = make_cleanup (xfree, index_img);
 602
 603       /* Enumeration litterals by themselves are potentially ambiguous.
 604          For instance, consider the following package spec:
 605
 606             package Pck is
 607                type Color is (Red, Green, Blue, White);
 608                type Blood_Cells is (White, Red);
 609             end Pck;
 610
 611          In this case, the litteral "red" for instance, or even
 612          the fully-qualified litteral "pck.red" cannot be resolved
 613          by itself.  Type qualification is needed to determine which
 614          enumeration litterals should be used.
 615
 616          The following variable will be used to contain the name
 617          of the array index type when such type qualification is
 618          needed.  */
 619       const char *index_type_name = NULL;
 620
 621       /* If the index type is a range type, find the base type.  */
 622       while (TYPE_CODE (index_type) == TYPE_CODE_RANGE)
 623         index_type = TYPE_TARGET_TYPE (index_type);
 624
 625       if (TYPE_CODE (index_type) == TYPE_CODE_ENUM
 626           || TYPE_CODE (index_type) == TYPE_CODE_BOOL)
 627         {
 628           index_type_name = ada_type_name (index_type);
 629           if (index_type_name)
 630             index_type_name = ada_decode (index_type_name);
 631         }
 632
 633       if (index_type_name != NULL)
 634         *child_path_expr =
 635           xstrprintf ("(%s)(%.*s'(%s))", parent_path_expr,
 636                       ada_name_prefix_len (index_type_name),
 637                       index_type_name, index_img);
 638       else
 639         *child_path_expr =
 640           xstrprintf ("(%s)(%s)", parent_path_expr, index_img);
 641       do_cleanups (cleanups);
 642     }
 643 }
 644
 645 /* See description at declaration above.  */
 646
 647 static void
 648 ada_varobj_describe_child (struct value *parent_value,
 649                            struct type *parent_type,
 650                            const char *parent_name,
 651                            const char *parent_path_expr,
 652                            int child_index,
 653                            char **child_name,
 654                            struct value **child_value,
 655                            struct type **child_type,
 656                            char **child_path_expr)
 657 {
 658   /* We cannot compute the child's path expression without
 659      the parent's path expression.  This is a pre-condition
 660      for calling this function.  */
 661   if (child_path_expr)
 662     gdb_assert (parent_path_expr != NULL);
 663
 664   ada_varobj_decode_var (&parent_value, &parent_type);
 665   ada_varobj_adjust_for_child_access (&parent_value, &parent_type);
 666
 667   if (child_name)
 668     *child_name = NULL;
 669   if (child_value)
 670     *child_value = NULL;
 671   if (child_type)
 672     *child_type = NULL;
 673   if (child_path_expr)
 674     *child_path_expr = NULL;
 675
 676   if (ada_is_array_descriptor_type (parent_type)
 677       && TYPE_CODE (parent_type) == TYPE_CODE_TYPEDEF)
 678     {
 679       ada_varobj_describe_ptr_child (parent_value, parent_type,
 680                                      parent_name, parent_path_expr,
 681                                      child_index, child_name,
 682                                      child_value, child_type,
 683                                      child_path_expr);
 684       return;
 685     }
 686
 687   if (TYPE_CODE (parent_type) == TYPE_CODE_ARRAY)
 688     {
 689       ada_varobj_describe_simple_array_child
 690         (parent_value, parent_type, parent_name, parent_path_expr,
 691          child_index, child_name, child_value, child_type,
 692          child_path_expr);
 693       return;
 694     }
 695
 696   if (TYPE_CODE (parent_type) == TYPE_CODE_STRUCT)
 697     {
 698       ada_varobj_describe_struct_child (parent_value, parent_type,
 699                                         parent_name, parent_path_expr,
 700                                         child_index, child_name,
 701                                         child_value, child_type,
 702                                         child_path_expr);
 703       return;
 704     }
 705
 706   if (TYPE_CODE (parent_type) == TYPE_CODE_PTR)
 707     {
 708       ada_varobj_describe_ptr_child (parent_value, parent_type,
 709                                      parent_name, parent_path_expr,
 710                                      child_index, child_name,
 711                                      child_value, child_type,
 712                                      child_path_expr);
 713       return;
 714     }
 715
 716   /* It should never happen.  But rather than crash, report dummy names
 717      and return a NULL child_value.  */
 718   if (child_name)
 719     *child_name = xstrdup ("???");
 720 }
 721
 722 /* Return the name of the child number CHILD_INDEX of the (PARENT_VALUE,
 723    PARENT_TYPE) pair.  PARENT_NAME is the name of the PARENT.
 724
 725    The result should be deallocated after use with xfree.  */
 726
 727 static char *
 728 ada_varobj_get_name_of_child (struct value *parent_value,
 729                               struct type *parent_type,
 730                               const char *parent_name, int child_index)
 731 {
 732   char *child_name;
 733
 734   ada_varobj_describe_child (parent_value, parent_type, parent_name,
 735                              NULL, child_index, &child_name, NULL,
 736                              NULL, NULL);
 737   return child_name;
 738 }
 739
 740 /* Return the path expression of the child number CHILD_INDEX of
 741    the (PARENT_VALUE, PARENT_TYPE) pair.  PARENT_NAME is the name
 742    of the parent, and PARENT_PATH_EXPR is the parent's path expression.
 743    Both must be non-NULL.
 744
 745    The result must be deallocated after use with xfree.  */
 746
 747 static char *
 748 ada_varobj_get_path_expr_of_child (struct value *parent_value,
 749                                    struct type *parent_type,
 750                                    const char *parent_name,
 751                                    const char *parent_path_expr,
 752                                    int child_index)
 753 {
 754   char *child_path_expr;
 755
 756   ada_varobj_describe_child (parent_value, parent_type, parent_name,
 757                              parent_path_expr, child_index, NULL,
 758                              NULL, NULL, &child_path_expr);
 759
 760   return child_path_expr;
 761 }
 762
 763 /* Return the value of child number CHILD_INDEX of the (PARENT_VALUE,
 764    PARENT_TYPE) pair.  PARENT_NAME is the name of the parent.  */
 765
 766 static struct value *
 767 ada_varobj_get_value_of_child (struct value *parent_value,
 768                                struct type *parent_type,
 769                                const char *parent_name, int child_index)
 770 {
 771   struct value *child_value;
 772
 773   ada_varobj_describe_child (parent_value, parent_type, parent_name,
 774                              NULL, child_index, NULL, &child_value,
 775                              NULL, NULL);
 776
 777   return child_value;
 778 }
 779
 780 /* Return the type of child number CHILD_INDEX of the (PARENT_VALUE,
 781    PARENT_TYPE) pair.  */
 782
 783 static struct type *
 784 ada_varobj_get_type_of_child (struct value *parent_value,
 785                               struct type *parent_type,
 786                               int child_index)
 787 {
 788   struct type *child_type;
 789
 790   ada_varobj_describe_child (parent_value, parent_type, NULL, NULL,
 791                              child_index, NULL, NULL, &child_type, NULL);
 792
 793   return child_type;
 794 }
 795
 796 /* Return a string that contains the image of the given VALUE, using
 797    the print options OPTS as the options for formatting the result.
 798
 799    The resulting string must be deallocated after use with xfree.  */
 800
 801 static char *
 802 ada_varobj_get_value_image (struct value *value,
 803                             struct value_print_options *opts)
 804 {
 805   char *result;
 806   struct ui_file *buffer;
 807   struct cleanup *old_chain;
 808
 809   buffer = mem_fileopen ();
 810   old_chain = make_cleanup_ui_file_delete (buffer);
 811
 812   common_val_print (value, buffer, 0, opts, current_language);
 813   result = ui_file_xstrdup (buffer, NULL);
 814
 815   do_cleanups (old_chain);
 816   return result;
 817 }
 818
 819 /* Assuming that the (VALUE, TYPE) pair designates an array varobj,
 820    return a string that is suitable for use in the "value" field of
 821    the varobj output.  Most of the time, this is the number of elements
 822    in the array inside square brackets, but there are situations where
 823    it's useful to add more info.
 824
 825    OPTS are the print options used when formatting the result.
 826
 827    The result should be deallocated after use using xfree.  */
 828
 829 static char *
 830 ada_varobj_get_value_of_array_variable (struct value *value,
 831                                         struct type *type,
 832                                         struct value_print_options *opts)
 833 {
 834   char *result;
 835   const int numchild = ada_varobj_get_array_number_of_children (value, type);
 836
 837   /* If we have a string, provide its contents in the "value" field.
 838      Otherwise, the only other way to inspect the contents of the string
 839      is by looking at the value of each element, as in any other array,
 840      which is not very convenient...  */
 841   if (value
 842       && ada_is_string_type (type)
 843       && (opts->format == 0 || opts->format == 's'))
 844     {
 845       char *str;
 846       struct cleanup *old_chain;
 847
 848       str = ada_varobj_get_value_image (value, opts);
 849       old_chain = make_cleanup (xfree, str);
 850       result = xstrprintf ("[%d] %s", numchild, str);
 851       do_cleanups (old_chain);
 852     }
 853   else
 854     result = xstrprintf ("[%d]", numchild);
 855
 856   return result;
 857 }
 858
 859 /* Return a string representation of the (VALUE, TYPE) pair, using
 860    the given print options OPTS as our formatting options.  */
 861
 862 static char *
 863 ada_varobj_get_value_of_variable (struct value *value,
 864                                   struct type *type,
 865                                   struct value_print_options *opts)
 866 {
 867   char *result = NULL;
 868
 869   ada_varobj_decode_var (&value, &type);
 870
 871   switch (TYPE_CODE (type))
 872     {
 873     case TYPE_CODE_STRUCT:
 874     case TYPE_CODE_UNION:
 875       result = xstrdup ("{...}");
 876       break;
 877     case TYPE_CODE_ARRAY:
 878       result = ada_varobj_get_value_of_array_variable (value, type, opts);
 879       break;
 880     default:
 881       if (!value)
 882         result = xstrdup ("");
 883       else
 884         result = ada_varobj_get_value_image (value, opts);
 885       break;
 886     }
 887
 888   return result;
 889 }
 890
 891 /* Ada specific callbacks for VAROBJs.  */
 892
 893 static int
 894 ada_number_of_children (struct varobj *var)
 895 {
 896   return ada_varobj_get_number_of_children (var->value, var->type);
 897 }
 898
 899 static char *
 900 ada_name_of_variable (struct varobj *parent)
 901 {
 902   return c_varobj_ops.name_of_variable (parent);
 903 }
 904
 905 static char *
 906 ada_name_of_child (struct varobj *parent, int index)
 907 {
 908   return ada_varobj_get_name_of_child (parent->value, parent->type,
 909                                        parent->name, index);
 910 }
 911
 912 static char*
 913 ada_path_expr_of_child (struct varobj *child)
 914 {
 915   struct varobj *parent = child->parent;
 916   const char *parent_path_expr = varobj_get_path_expr (parent);
 917
 918   return ada_varobj_get_path_expr_of_child (parent->value,
 919                                             parent->type,
 920                                             parent->name,
 921                                             parent_path_expr,
 922                                             child->index);
 923 }
 924
 925 static struct value *
 926 ada_value_of_child (struct varobj *parent, int index)
 927 {
 928   return ada_varobj_get_value_of_child (parent->value, parent->type,
 929                                         parent->name, index);
 930 }
 931
 932 static struct type *
 933 ada_type_of_child (struct varobj *parent, int index)
 934 {
 935   return ada_varobj_get_type_of_child (parent->value, parent->type,
 936                                        index);
 937 }
 938
 939 static char *
 940 ada_value_of_variable (struct varobj *var, enum varobj_display_formats format)
 941 {
 942   struct value_print_options opts;
 943
 944   varobj_formatted_print_options (&opts, format);
 945
 946   return ada_varobj_get_value_of_variable (var->value, var->type, &opts);
 947 }
 948
 949 /* Implement the "value_is_changeable_p" routine for Ada.  */
 950
 951 static int
 952 ada_value_is_changeable_p (struct varobj *var)
 953 {
 954   struct type *type = var->value ? value_type (var->value) : var->type;
 955
 956   if (ada_is_array_descriptor_type (type)
 957       && TYPE_CODE (type) == TYPE_CODE_TYPEDEF)
 958     {
 959       /* This is in reality a pointer to an unconstrained array.
 960          its value is changeable.  */
 961       return 1;
 962     }
 963
 964   if (ada_is_string_type (type))
 965     {
 966       /* We display the contents of the string in the array's
 967          "value" field.  The contents can change, so consider
 968          that the array is changeable.  */
 969       return 1;
 970     }
 971
 972   return varobj_default_value_is_changeable_p (var);
 973 }
 974
 975 /* Implement the "value_has_mutated" routine for Ada.  */
 976
 977 static int
 978 ada_value_has_mutated (struct varobj *var, struct value *new_val,
 979                        struct type *new_type)
 980 {
 981   int i;
 982   int from = -1;
 983   int to = -1;
 984
 985   /* If the number of fields have changed, then for sure the type
 986      has mutated.  */
 987   if (ada_varobj_get_number_of_children (new_val, new_type)
 988       != var->num_children)
 989     return 1;
 990
 991   /* If the number of fields have remained the same, then we need
 992      to check the name of each field.  If they remain the same,
 993      then chances are the type hasn't mutated.  This is technically
 994      an incomplete test, as the child's type might have changed
 995      despite the fact that the name remains the same.  But we'll
 996      handle this situation by saying that the child has mutated,
 997      not this value.
 998
 999      If only part (or none!) of the children have been fetched,
1000      then only check the ones we fetched.  It does not matter
1001      to the frontend whether a child that it has not fetched yet
1002      has mutated or not. So just assume it hasn't.  */
1003
1004   varobj_restrict_range (var->children, &from, &to);
1005   for (i = from; i < to; i++)
1006     if (strcmp (ada_varobj_get_name_of_child (new_val, new_type,
1007                                               var->name, i),
1008                 VEC_index (varobj_p, var->children, i)->name) != 0)
1009       return 1;
1010
1011   return 0;
1012 }
1013
1014 /* varobj operations for ada.  */
1015
1016 const struct lang_varobj_ops ada_varobj_ops =
1017 {
1018   ada_number_of_children,
1019   ada_name_of_variable,
1020   ada_name_of_child,
1021   ada_path_expr_of_child,
1022   ada_value_of_child,
1023   ada_type_of_child,
1024   ada_value_of_variable,
1025   ada_value_is_changeable_p,
1026   ada_value_has_mutated
1027 };