gdb/ada-varobj.c

   1 /* varobj support for Ada.
   2
   3    Copyright (C) 2012-2020 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_access_to_unconstrained_array (parent_type))
 354     return 1;
 355
 356   if (TYPE_CODE (parent_type) == TYPE_CODE_ARRAY)
 357     return ada_varobj_get_array_number_of_children (parent_value,
 358                                                     parent_type);
 359
 360   if (TYPE_CODE (parent_type) == TYPE_CODE_STRUCT
 361       || TYPE_CODE (parent_type) == TYPE_CODE_UNION)
 362     return ada_varobj_get_struct_number_of_children (parent_value,
 363                                                      parent_type);
 364
 365   if (TYPE_CODE (parent_type) == TYPE_CODE_PTR)
 366     return ada_varobj_get_ptr_number_of_children (parent_value,
 367                                                   parent_type);
 368
 369   /* All other types have no child.  */
 370   return 0;
 371 }
 372
 373 /* Describe the child of the (PARENT_VALUE, PARENT_TYPE) pair
 374    whose index is CHILD_INDEX:
 375
 376      - If CHILD_NAME is not NULL, then a copy of the child's name
 377        is saved in *CHILD_NAME.  This copy must be deallocated
 378        with xfree after use.
 379
 380      - If CHILD_VALUE is not NULL, then save the child's value
 381        in *CHILD_VALUE. Same thing for the child's type with
 382        CHILD_TYPE if not NULL.
 383
 384      - If CHILD_PATH_EXPR is not NULL, then compute the child's
 385        path expression.  The resulting string must be deallocated
 386        after use with xfree.
 387
 388        Computing the child's path expression requires the PARENT_PATH_EXPR
 389        to be non-NULL.  Otherwise, PARENT_PATH_EXPR may be null if
 390        CHILD_PATH_EXPR is NULL.
 391
 392   PARENT_NAME is the name of the parent, and should never be NULL.  */
 393
 394 static void ada_varobj_describe_child (struct value *parent_value,
 395                                        struct type *parent_type,
 396                                        const char *parent_name,
 397                                        const char *parent_path_expr,
 398                                        int child_index,
 399                                        std::string *child_name,
 400                                        struct value **child_value,
 401                                        struct type **child_type,
 402                                        std::string *child_path_expr);
 403
 404 /* Same as ada_varobj_describe_child, but limited to struct/union
 405    objects.  */
 406
 407 static void
 408 ada_varobj_describe_struct_child (struct value *parent_value,
 409                                   struct type *parent_type,
 410                                   const char *parent_name,
 411                                   const char *parent_path_expr,
 412                                   int child_index,
 413                                   std::string *child_name,
 414                                   struct value **child_value,
 415                                   struct type **child_type,
 416                                   std::string *child_path_expr)
 417 {
 418   int fieldno;
 419   int childno = 0;
 420
 421   gdb_assert (TYPE_CODE (parent_type) == TYPE_CODE_STRUCT
 422               || TYPE_CODE (parent_type) == TYPE_CODE_UNION);
 423
 424   for (fieldno = 0; fieldno < TYPE_NFIELDS (parent_type); fieldno++)
 425     {
 426       if (ada_is_ignored_field (parent_type, fieldno))
 427         continue;
 428
 429       if (ada_is_wrapper_field (parent_type, fieldno))
 430         {
 431           struct value *elt_value;
 432           struct type *elt_type;
 433           int elt_n_children;
 434
 435           ada_varobj_struct_elt (parent_value, parent_type, fieldno,
 436                                  &elt_value, &elt_type);
 437           if (ada_is_tagged_type (elt_type, 0))
 438             {
 439               /* Same as in ada_varobj_get_struct_number_of_children:
 440                  For tagged types, we must be careful to not call
 441                  ada_varobj_get_number_of_children, to prevent our
 442                  element from being fixed back into the parent.  */
 443               elt_n_children = ada_varobj_get_struct_number_of_children
 444                 (elt_value, elt_type);
 445             }
 446           else
 447             elt_n_children =
 448               ada_varobj_get_number_of_children (elt_value, elt_type);
 449
 450           /* Is the child we're looking for one of the children
 451              of this wrapper field?  */
 452           if (child_index - childno < elt_n_children)
 453             {
 454               if (ada_is_tagged_type (elt_type, 0))
 455                 {
 456                   /* Same as in ada_varobj_get_struct_number_of_children:
 457                      For tagged types, we must be careful to not call
 458                      ada_varobj_describe_child, to prevent our element
 459                      from being fixed back into the parent.  */
 460                   ada_varobj_describe_struct_child
 461                     (elt_value, elt_type, parent_name, parent_path_expr,
 462                      child_index - childno, child_name, child_value,
 463                      child_type, child_path_expr);
 464                 }
 465               else
 466                 ada_varobj_describe_child (elt_value, elt_type,
 467                                            parent_name, parent_path_expr,
 468                                            child_index - childno,
 469                                            child_name, child_value,
 470                                            child_type, child_path_expr);
 471               return;
 472             }
 473
 474           /* The child we're looking for is beyond this wrapper
 475              field, so skip all its children.  */
 476           childno += elt_n_children;
 477           continue;
 478         }
 479       else if (ada_is_variant_part (parent_type, fieldno))
 480         {
 481           /* In normal situations, the variant part of the record should
 482              have been "fixed". Or, in other words, it should have been
 483              replaced by the branch of the variant part that is relevant
 484              for our value.  But there are still situations where this
 485              can happen, however (Eg. when our parent is a NULL pointer).
 486              We do not support showing this part of the record for now,
 487              so just pretend this field does not exist.  */
 488           continue;
 489         }
 490
 491       if (childno == child_index)
 492         {
 493           if (child_name)
 494             {
 495               /* The name of the child is none other than the field's
 496                  name, except that we need to strip suffixes from it.
 497                  For instance, fields with alignment constraints will
 498                  have an __XVA suffix added to them.  */
 499               const char *field_name = TYPE_FIELD_NAME (parent_type, fieldno);
 500               int child_name_len = ada_name_prefix_len (field_name);
 501
 502               *child_name = string_printf ("%.*s", child_name_len, field_name);
 503             }
 504
 505           if (child_value && parent_value)
 506             ada_varobj_struct_elt (parent_value, parent_type, fieldno,
 507                                    child_value, NULL);
 508
 509           if (child_type)
 510             ada_varobj_struct_elt (parent_value, parent_type, fieldno,
 511                                    NULL, child_type);
 512
 513           if (child_path_expr)
 514             {
 515               /* The name of the child is none other than the field's
 516                  name, except that we need to strip suffixes from it.
 517                  For instance, fields with alignment constraints will
 518                  have an __XVA suffix added to them.  */
 519               const char *field_name = TYPE_FIELD_NAME (parent_type, fieldno);
 520               int child_name_len = ada_name_prefix_len (field_name);
 521
 522               *child_path_expr =
 523                 string_printf ("(%s).%.*s", parent_path_expr,
 524                                child_name_len, field_name);
 525             }
 526
 527           return;
 528         }
 529
 530       childno++;
 531     }
 532
 533   /* Something went wrong.  Either we miscounted the number of
 534      children, or CHILD_INDEX was too high.  But we should never
 535      reach here.  We don't have enough information to recover
 536      nicely, so just raise an assertion failure.  */
 537   gdb_assert_not_reached ("unexpected code path");
 538 }
 539
 540 /* Same as ada_varobj_describe_child, but limited to pointer objects.
 541
 542    Note that CHILD_INDEX is unused in this situation, but still provided
 543    for consistency of interface with other routines describing an object's
 544    child.  */
 545
 546 static void
 547 ada_varobj_describe_ptr_child (struct value *parent_value,
 548                                struct type *parent_type,
 549                                const char *parent_name,
 550                                const char *parent_path_expr,
 551                                int child_index,
 552                                std::string *child_name,
 553                                struct value **child_value,
 554                                struct type **child_type,
 555                                std::string *child_path_expr)
 556 {
 557   if (child_name)
 558     *child_name = string_printf ("%s.all", parent_name);
 559
 560   if (child_value && parent_value)
 561     ada_varobj_ind (parent_value, parent_type, child_value, NULL);
 562
 563   if (child_type)
 564     ada_varobj_ind (parent_value, parent_type, NULL, child_type);
 565
 566   if (child_path_expr)
 567     *child_path_expr = string_printf ("(%s).all", parent_path_expr);
 568 }
 569
 570 /* Same as ada_varobj_describe_child, limited to simple array objects
 571    (TYPE_CODE_ARRAY only).
 572
 573    Assumes that the (PARENT_VALUE, PARENT_TYPE) pair is properly decoded.
 574    This is done by ada_varobj_describe_child before calling us.  */
 575
 576 static void
 577 ada_varobj_describe_simple_array_child (struct value *parent_value,
 578                                         struct type *parent_type,
 579                                         const char *parent_name,
 580                                         const char *parent_path_expr,
 581                                         int child_index,
 582                                         std::string *child_name,
 583                                         struct value **child_value,
 584                                         struct type **child_type,
 585                                         std::string *child_path_expr)
 586 {
 587   struct type *index_type;
 588   int real_index;
 589
 590   gdb_assert (TYPE_CODE (parent_type) == TYPE_CODE_ARRAY);
 591
 592   index_type = TYPE_INDEX_TYPE (parent_type);
 593   real_index = child_index + ada_discrete_type_low_bound (index_type);
 594
 595   if (child_name)
 596     *child_name = ada_varobj_scalar_image (index_type, real_index);
 597
 598   if (child_value && parent_value)
 599     ada_varobj_simple_array_elt (parent_value, parent_type, real_index,
 600                                  child_value, NULL);
 601
 602   if (child_type)
 603     ada_varobj_simple_array_elt (parent_value, parent_type, real_index,
 604                                  NULL, child_type);
 605
 606   if (child_path_expr)
 607     {
 608       std::string index_img = ada_varobj_scalar_image (index_type, real_index);
 609
 610       /* Enumeration litterals by themselves are potentially ambiguous.
 611          For instance, consider the following package spec:
 612
 613             package Pck is
 614                type Color is (Red, Green, Blue, White);
 615                type Blood_Cells is (White, Red);
 616             end Pck;
 617
 618          In this case, the litteral "red" for instance, or even
 619          the fully-qualified litteral "pck.red" cannot be resolved
 620          by itself.  Type qualification is needed to determine which
 621          enumeration litterals should be used.
 622
 623          The following variable will be used to contain the name
 624          of the array index type when such type qualification is
 625          needed.  */
 626       const char *index_type_name = NULL;
 627       std::string decoded;
 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             {
 639               decoded = ada_decode (index_type_name);
 640               index_type_name = decoded.c_str ();
 641             }
 642         }
 643
 644       if (index_type_name != NULL)
 645         *child_path_expr =
 646           string_printf ("(%s)(%.*s'(%s))", parent_path_expr,
 647                          ada_name_prefix_len (index_type_name),
 648                          index_type_name, index_img.c_str ());
 649       else
 650         *child_path_expr =
 651           string_printf ("(%s)(%s)", parent_path_expr, index_img.c_str ());
 652     }
 653 }
 654
 655 /* See description at declaration above.  */
 656
 657 static void
 658 ada_varobj_describe_child (struct value *parent_value,
 659                            struct type *parent_type,
 660                            const char *parent_name,
 661                            const char *parent_path_expr,
 662                            int child_index,
 663                            std::string *child_name,
 664                            struct value **child_value,
 665                            struct type **child_type,
 666                            std::string *child_path_expr)
 667 {
 668   /* We cannot compute the child's path expression without
 669      the parent's path expression.  This is a pre-condition
 670      for calling this function.  */
 671   if (child_path_expr)
 672     gdb_assert (parent_path_expr != NULL);
 673
 674   ada_varobj_decode_var (&parent_value, &parent_type);
 675   ada_varobj_adjust_for_child_access (&parent_value, &parent_type);
 676
 677   if (child_name)
 678     *child_name = std::string ();
 679   if (child_value)
 680     *child_value = NULL;
 681   if (child_type)
 682     *child_type = NULL;
 683   if (child_path_expr)
 684     *child_path_expr = std::string ();
 685
 686   if (ada_is_access_to_unconstrained_array (parent_type))
 687     {
 688       ada_varobj_describe_ptr_child (parent_value, parent_type,
 689                                      parent_name, parent_path_expr,
 690                                      child_index, child_name,
 691                                      child_value, child_type,
 692                                      child_path_expr);
 693       return;
 694     }
 695
 696   if (TYPE_CODE (parent_type) == TYPE_CODE_ARRAY)
 697     {
 698       ada_varobj_describe_simple_array_child
 699         (parent_value, parent_type, parent_name, parent_path_expr,
 700          child_index, child_name, child_value, child_type,
 701          child_path_expr);
 702       return;
 703     }
 704
 705   if (TYPE_CODE (parent_type) == TYPE_CODE_STRUCT
 706       || TYPE_CODE (parent_type) == TYPE_CODE_UNION)
 707     {
 708       ada_varobj_describe_struct_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   if (TYPE_CODE (parent_type) == TYPE_CODE_PTR)
 717     {
 718       ada_varobj_describe_ptr_child (parent_value, parent_type,
 719                                      parent_name, parent_path_expr,
 720                                      child_index, child_name,
 721                                      child_value, child_type,
 722                                      child_path_expr);
 723       return;
 724     }
 725
 726   /* It should never happen.  But rather than crash, report dummy names
 727      and return a NULL child_value.  */
 728   if (child_name)
 729     *child_name = "???";
 730 }
 731
 732 /* Return the name of the child number CHILD_INDEX of the (PARENT_VALUE,
 733    PARENT_TYPE) pair.  PARENT_NAME is the name of the PARENT.  */
 734
 735 static std::string
 736 ada_varobj_get_name_of_child (struct value *parent_value,
 737                               struct type *parent_type,
 738                               const char *parent_name, int child_index)
 739 {
 740   std::string child_name;
 741
 742   ada_varobj_describe_child (parent_value, parent_type, parent_name,
 743                              NULL, child_index, &child_name, NULL,
 744                              NULL, NULL);
 745   return child_name;
 746 }
 747
 748 /* Return the path expression of the child number CHILD_INDEX of
 749    the (PARENT_VALUE, PARENT_TYPE) pair.  PARENT_NAME is the name
 750    of the parent, and PARENT_PATH_EXPR is the parent's path expression.
 751    Both must be non-NULL.  */
 752
 753 static std::string
 754 ada_varobj_get_path_expr_of_child (struct value *parent_value,
 755                                    struct type *parent_type,
 756                                    const char *parent_name,
 757                                    const char *parent_path_expr,
 758                                    int child_index)
 759 {
 760   std::string child_path_expr;
 761
 762   ada_varobj_describe_child (parent_value, parent_type, parent_name,
 763                              parent_path_expr, child_index, NULL,
 764                              NULL, NULL, &child_path_expr);
 765
 766   return child_path_expr;
 767 }
 768
 769 /* Return the value of child number CHILD_INDEX of the (PARENT_VALUE,
 770    PARENT_TYPE) pair.  PARENT_NAME is the name of the parent.  */
 771
 772 static struct value *
 773 ada_varobj_get_value_of_child (struct value *parent_value,
 774                                struct type *parent_type,
 775                                const char *parent_name, int child_index)
 776 {
 777   struct value *child_value;
 778
 779   ada_varobj_describe_child (parent_value, parent_type, parent_name,
 780                              NULL, child_index, NULL, &child_value,
 781                              NULL, NULL);
 782
 783   return child_value;
 784 }
 785
 786 /* Return the type of child number CHILD_INDEX of the (PARENT_VALUE,
 787    PARENT_TYPE) pair.  */
 788
 789 static struct type *
 790 ada_varobj_get_type_of_child (struct value *parent_value,
 791                               struct type *parent_type,
 792                               int child_index)
 793 {
 794   struct type *child_type;
 795
 796   ada_varobj_describe_child (parent_value, parent_type, NULL, NULL,
 797                              child_index, NULL, NULL, &child_type, NULL);
 798
 799   return child_type;
 800 }
 801
 802 /* Return a string that contains the image of the given VALUE, using
 803    the print options OPTS as the options for formatting the result.
 804
 805    The resulting string must be deallocated after use with xfree.  */
 806
 807 static std::string
 808 ada_varobj_get_value_image (struct value *value,
 809                             struct value_print_options *opts)
 810 {
 811   string_file buffer;
 812
 813   common_val_print (value, &buffer, 0, opts, current_language);
 814   return std::move (buffer.string ());
 815 }
 816
 817 /* Assuming that the (VALUE, TYPE) pair designates an array varobj,
 818    return a string that is suitable for use in the "value" field of
 819    the varobj output.  Most of the time, this is the number of elements
 820    in the array inside square brackets, but there are situations where
 821    it's useful to add more info.
 822
 823    OPTS are the print options used when formatting the result.
 824
 825    The result should be deallocated after use using xfree.  */
 826
 827 static std::string
 828 ada_varobj_get_value_of_array_variable (struct value *value,
 829                                         struct type *type,
 830                                         struct value_print_options *opts)
 831 {
 832   const int numchild = ada_varobj_get_array_number_of_children (value, type);
 833
 834   /* If we have a string, provide its contents in the "value" field.
 835      Otherwise, the only other way to inspect the contents of the string
 836      is by looking at the value of each element, as in any other array,
 837      which is not very convenient...  */
 838   if (value
 839       && ada_is_string_type (type)
 840       && (opts->format == 0 || opts->format == 's'))
 841     {
 842       std::string str = ada_varobj_get_value_image (value, opts);
 843       return string_printf ("[%d] %s", numchild, str.c_str ());
 844     }
 845   else
 846     return string_printf ("[%d]", numchild);
 847 }
 848
 849 /* Return a string representation of the (VALUE, TYPE) pair, using
 850    the given print options OPTS as our formatting options.  */
 851
 852 static std::string
 853 ada_varobj_get_value_of_variable (struct value *value,
 854                                   struct type *type,
 855                                   struct value_print_options *opts)
 856 {
 857   ada_varobj_decode_var (&value, &type);
 858
 859   switch (TYPE_CODE (type))
 860     {
 861     case TYPE_CODE_STRUCT:
 862     case TYPE_CODE_UNION:
 863       return "{...}";
 864     case TYPE_CODE_ARRAY:
 865       return ada_varobj_get_value_of_array_variable (value, type, opts);
 866     default:
 867       if (!value)
 868         return "";
 869       else
 870         return ada_varobj_get_value_image (value, opts);
 871     }
 872 }
 873
 874 /* Ada specific callbacks for VAROBJs.  */
 875
 876 static int
 877 ada_number_of_children (const struct varobj *var)
 878 {
 879   return ada_varobj_get_number_of_children (var->value.get (), var->type);
 880 }
 881
 882 static std::string
 883 ada_name_of_variable (const struct varobj *parent)
 884 {
 885   return c_varobj_ops.name_of_variable (parent);
 886 }
 887
 888 static std::string
 889 ada_name_of_child (const struct varobj *parent, int index)
 890 {
 891   return ada_varobj_get_name_of_child (parent->value.get (), parent->type,
 892                                        parent->name.c_str (), index);
 893 }
 894
 895 static std::string
 896 ada_path_expr_of_child (const struct varobj *child)
 897 {
 898   const struct varobj *parent = child->parent;
 899   const char *parent_path_expr = varobj_get_path_expr (parent);
 900
 901   return ada_varobj_get_path_expr_of_child (parent->value.get (),
 902                                             parent->type,
 903                                             parent->name.c_str (),
 904                                             parent_path_expr,
 905                                             child->index);
 906 }
 907
 908 static struct value *
 909 ada_value_of_child (const struct varobj *parent, int index)
 910 {
 911   return ada_varobj_get_value_of_child (parent->value.get (), parent->type,
 912                                         parent->name.c_str (), index);
 913 }
 914
 915 static struct type *
 916 ada_type_of_child (const struct varobj *parent, int index)
 917 {
 918   return ada_varobj_get_type_of_child (parent->value.get (), parent->type,
 919                                        index);
 920 }
 921
 922 static std::string
 923 ada_value_of_variable (const struct varobj *var,
 924                        enum varobj_display_formats format)
 925 {
 926   struct value_print_options opts;
 927
 928   varobj_formatted_print_options (&opts, format);
 929
 930   return ada_varobj_get_value_of_variable (var->value.get (), var->type,
 931                                            &opts);
 932 }
 933
 934 /* Implement the "value_is_changeable_p" routine for Ada.  */
 935
 936 static bool
 937 ada_value_is_changeable_p (const struct varobj *var)
 938 {
 939   struct type *type = (var->value != nullptr
 940                        ? value_type (var->value.get ()) : var->type);
 941
 942   if (TYPE_CODE (type) == TYPE_CODE_REF)
 943     type = TYPE_TARGET_TYPE (type);
 944
 945   if (ada_is_access_to_unconstrained_array (type))
 946     {
 947       /* This is in reality a pointer to an unconstrained array.
 948          its value is changeable.  */
 949       return true;
 950     }
 951
 952   if (ada_is_string_type (type))
 953     {
 954       /* We display the contents of the string in the array's
 955          "value" field.  The contents can change, so consider
 956          that the array is changeable.  */
 957       return true;
 958     }
 959
 960   return varobj_default_value_is_changeable_p (var);
 961 }
 962
 963 /* Implement the "value_has_mutated" routine for Ada.  */
 964
 965 static bool
 966 ada_value_has_mutated (const struct varobj *var, struct value *new_val,
 967                        struct type *new_type)
 968 {
 969   int from = -1;
 970   int to = -1;
 971
 972   /* If the number of fields have changed, then for sure the type
 973      has mutated.  */
 974   if (ada_varobj_get_number_of_children (new_val, new_type)
 975       != var->num_children)
 976     return true;
 977
 978   /* If the number of fields have remained the same, then we need
 979      to check the name of each field.  If they remain the same,
 980      then chances are the type hasn't mutated.  This is technically
 981      an incomplete test, as the child's type might have changed
 982      despite the fact that the name remains the same.  But we'll
 983      handle this situation by saying that the child has mutated,
 984      not this value.
 985
 986      If only part (or none!) of the children have been fetched,
 987      then only check the ones we fetched.  It does not matter
 988      to the frontend whether a child that it has not fetched yet
 989      has mutated or not. So just assume it hasn't.  */
 990
 991   varobj_restrict_range (var->children, &from, &to);
 992   for (int i = from; i < to; i++)
 993     if (ada_varobj_get_name_of_child (new_val, new_type,
 994                                       var->name.c_str (), i)
 995         != var->children[i]->name)
 996       return true;
 997
 998   return false;
 999 }
1000
1001 /* varobj operations for ada.  */
1002
1003 const struct lang_varobj_ops ada_varobj_ops =
1004 {
1005   ada_number_of_children,
1006   ada_name_of_variable,
1007   ada_name_of_child,
1008   ada_path_expr_of_child,
1009   ada_value_of_child,
1010   ada_type_of_child,
1011   ada_value_of_variable,
1012   ada_value_is_changeable_p,
1013   ada_value_has_mutated,
1014   varobj_default_is_path_expr_parent
1015 };