gdb/ada-varobj.c

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