gdb/ada-varobj.c

   1 /* varobj support for Ada.
   2
   3    Copyright (C) 2012-2019 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
 628       /* If the index type is a range type, find the base type.  */
 629       while (TYPE_CODE (index_type) == TYPE_CODE_RANGE)
 630         index_type = TYPE_TARGET_TYPE (index_type);
 631
 632       if (TYPE_CODE (index_type) == TYPE_CODE_ENUM
 633           || TYPE_CODE (index_type) == TYPE_CODE_BOOL)
 634         {
 635           index_type_name = ada_type_name (index_type);
 636           if (index_type_name)
 637             index_type_name = ada_decode (index_type_name);
 638         }
 639
 640       if (index_type_name != NULL)
 641         *child_path_expr =
 642           string_printf ("(%s)(%.*s'(%s))", parent_path_expr,
 643                          ada_name_prefix_len (index_type_name),
 644                          index_type_name, index_img.c_str ());
 645       else
 646         *child_path_expr =
 647           string_printf ("(%s)(%s)", parent_path_expr, index_img.c_str ());
 648     }
 649 }
 650
 651 /* See description at declaration above.  */
 652
 653 static void
 654 ada_varobj_describe_child (struct value *parent_value,
 655                            struct type *parent_type,
 656                            const char *parent_name,
 657                            const char *parent_path_expr,
 658                            int child_index,
 659                            std::string *child_name,
 660                            struct value **child_value,
 661                            struct type **child_type,
 662                            std::string *child_path_expr)
 663 {
 664   /* We cannot compute the child's path expression without
 665      the parent's path expression.  This is a pre-condition
 666      for calling this function.  */
 667   if (child_path_expr)
 668     gdb_assert (parent_path_expr != NULL);
 669
 670   ada_varobj_decode_var (&parent_value, &parent_type);
 671   ada_varobj_adjust_for_child_access (&parent_value, &parent_type);
 672
 673   if (child_name)
 674     *child_name = std::string ();
 675   if (child_value)
 676     *child_value = NULL;
 677   if (child_type)
 678     *child_type = NULL;
 679   if (child_path_expr)
 680     *child_path_expr = std::string ();
 681
 682   if (ada_is_access_to_unconstrained_array (parent_type))
 683     {
 684       ada_varobj_describe_ptr_child (parent_value, parent_type,
 685                                      parent_name, parent_path_expr,
 686                                      child_index, child_name,
 687                                      child_value, child_type,
 688                                      child_path_expr);
 689       return;
 690     }
 691
 692   if (TYPE_CODE (parent_type) == TYPE_CODE_ARRAY)
 693     {
 694       ada_varobj_describe_simple_array_child
 695         (parent_value, parent_type, parent_name, parent_path_expr,
 696          child_index, child_name, child_value, child_type,
 697          child_path_expr);
 698       return;
 699     }
 700
 701   if (TYPE_CODE (parent_type) == TYPE_CODE_STRUCT
 702       || TYPE_CODE (parent_type) == TYPE_CODE_UNION)
 703     {
 704       ada_varobj_describe_struct_child (parent_value, parent_type,
 705                                         parent_name, parent_path_expr,
 706                                         child_index, child_name,
 707                                         child_value, child_type,
 708                                         child_path_expr);
 709       return;
 710     }
 711
 712   if (TYPE_CODE (parent_type) == TYPE_CODE_PTR)
 713     {
 714       ada_varobj_describe_ptr_child (parent_value, parent_type,
 715                                      parent_name, parent_path_expr,
 716                                      child_index, child_name,
 717                                      child_value, child_type,
 718                                      child_path_expr);
 719       return;
 720     }
 721
 722   /* It should never happen.  But rather than crash, report dummy names
 723      and return a NULL child_value.  */
 724   if (child_name)
 725     *child_name = "???";
 726 }
 727
 728 /* Return the name of the child number CHILD_INDEX of the (PARENT_VALUE,
 729    PARENT_TYPE) pair.  PARENT_NAME is the name of the PARENT.  */
 730
 731 static std::string
 732 ada_varobj_get_name_of_child (struct value *parent_value,
 733                               struct type *parent_type,
 734                               const char *parent_name, int child_index)
 735 {
 736   std::string child_name;
 737
 738   ada_varobj_describe_child (parent_value, parent_type, parent_name,
 739                              NULL, child_index, &child_name, NULL,
 740                              NULL, NULL);
 741   return child_name;
 742 }
 743
 744 /* Return the path expression of the child number CHILD_INDEX of
 745    the (PARENT_VALUE, PARENT_TYPE) pair.  PARENT_NAME is the name
 746    of the parent, and PARENT_PATH_EXPR is the parent's path expression.
 747    Both must be non-NULL.  */
 748
 749 static std::string
 750 ada_varobj_get_path_expr_of_child (struct value *parent_value,
 751                                    struct type *parent_type,
 752                                    const char *parent_name,
 753                                    const char *parent_path_expr,
 754                                    int child_index)
 755 {
 756   std::string child_path_expr;
 757
 758   ada_varobj_describe_child (parent_value, parent_type, parent_name,
 759                              parent_path_expr, child_index, NULL,
 760                              NULL, NULL, &child_path_expr);
 761
 762   return child_path_expr;
 763 }
 764
 765 /* Return the value of child number CHILD_INDEX of the (PARENT_VALUE,
 766    PARENT_TYPE) pair.  PARENT_NAME is the name of the parent.  */
 767
 768 static struct value *
 769 ada_varobj_get_value_of_child (struct value *parent_value,
 770                                struct type *parent_type,
 771                                const char *parent_name, int child_index)
 772 {
 773   struct value *child_value;
 774
 775   ada_varobj_describe_child (parent_value, parent_type, parent_name,
 776                              NULL, child_index, NULL, &child_value,
 777                              NULL, NULL);
 778
 779   return child_value;
 780 }
 781
 782 /* Return the type of child number CHILD_INDEX of the (PARENT_VALUE,
 783    PARENT_TYPE) pair.  */
 784
 785 static struct type *
 786 ada_varobj_get_type_of_child (struct value *parent_value,
 787                               struct type *parent_type,
 788                               int child_index)
 789 {
 790   struct type *child_type;
 791
 792   ada_varobj_describe_child (parent_value, parent_type, NULL, NULL,
 793                              child_index, NULL, NULL, &child_type, NULL);
 794
 795   return child_type;
 796 }
 797
 798 /* Return a string that contains the image of the given VALUE, using
 799    the print options OPTS as the options for formatting the result.
 800
 801    The resulting string must be deallocated after use with xfree.  */
 802
 803 static std::string
 804 ada_varobj_get_value_image (struct value *value,
 805                             struct value_print_options *opts)
 806 {
 807   string_file buffer;
 808
 809   common_val_print (value, &buffer, 0, opts, current_language);
 810   return std::move (buffer.string ());
 811 }
 812
 813 /* Assuming that the (VALUE, TYPE) pair designates an array varobj,
 814    return a string that is suitable for use in the "value" field of
 815    the varobj output.  Most of the time, this is the number of elements
 816    in the array inside square brackets, but there are situations where
 817    it's useful to add more info.
 818
 819    OPTS are the print options used when formatting the result.
 820
 821    The result should be deallocated after use using xfree.  */
 822
 823 static std::string
 824 ada_varobj_get_value_of_array_variable (struct value *value,
 825                                         struct type *type,
 826                                         struct value_print_options *opts)
 827 {
 828   const int numchild = ada_varobj_get_array_number_of_children (value, type);
 829
 830   /* If we have a string, provide its contents in the "value" field.
 831      Otherwise, the only other way to inspect the contents of the string
 832      is by looking at the value of each element, as in any other array,
 833      which is not very convenient...  */
 834   if (value
 835       && ada_is_string_type (type)
 836       && (opts->format == 0 || opts->format == 's'))
 837     {
 838       std::string str = ada_varobj_get_value_image (value, opts);
 839       return string_printf ("[%d] %s", numchild, str.c_str ());
 840     }
 841   else
 842     return string_printf ("[%d]", numchild);
 843 }
 844
 845 /* Return a string representation of the (VALUE, TYPE) pair, using
 846    the given print options OPTS as our formatting options.  */
 847
 848 static std::string
 849 ada_varobj_get_value_of_variable (struct value *value,
 850                                   struct type *type,
 851                                   struct value_print_options *opts)
 852 {
 853   ada_varobj_decode_var (&value, &type);
 854
 855   switch (TYPE_CODE (type))
 856     {
 857     case TYPE_CODE_STRUCT:
 858     case TYPE_CODE_UNION:
 859       return "{...}";
 860     case TYPE_CODE_ARRAY:
 861       return ada_varobj_get_value_of_array_variable (value, type, opts);
 862     default:
 863       if (!value)
 864         return "";
 865       else
 866         return ada_varobj_get_value_image (value, opts);
 867     }
 868 }
 869
 870 /* Ada specific callbacks for VAROBJs.  */
 871
 872 static int
 873 ada_number_of_children (const struct varobj *var)
 874 {
 875   return ada_varobj_get_number_of_children (var->value.get (), var->type);
 876 }
 877
 878 static std::string
 879 ada_name_of_variable (const struct varobj *parent)
 880 {
 881   return c_varobj_ops.name_of_variable (parent);
 882 }
 883
 884 static std::string
 885 ada_name_of_child (const struct varobj *parent, int index)
 886 {
 887   return ada_varobj_get_name_of_child (parent->value.get (), parent->type,
 888                                        parent->name.c_str (), index);
 889 }
 890
 891 static std::string
 892 ada_path_expr_of_child (const struct varobj *child)
 893 {
 894   const struct varobj *parent = child->parent;
 895   const char *parent_path_expr = varobj_get_path_expr (parent);
 896
 897   return ada_varobj_get_path_expr_of_child (parent->value.get (),
 898                                             parent->type,
 899                                             parent->name.c_str (),
 900                                             parent_path_expr,
 901                                             child->index);
 902 }
 903
 904 static struct value *
 905 ada_value_of_child (const struct varobj *parent, int index)
 906 {
 907   return ada_varobj_get_value_of_child (parent->value.get (), parent->type,
 908                                         parent->name.c_str (), index);
 909 }
 910
 911 static struct type *
 912 ada_type_of_child (const struct varobj *parent, int index)
 913 {
 914   return ada_varobj_get_type_of_child (parent->value.get (), parent->type,
 915                                        index);
 916 }
 917
 918 static std::string
 919 ada_value_of_variable (const struct varobj *var,
 920                        enum varobj_display_formats format)
 921 {
 922   struct value_print_options opts;
 923
 924   varobj_formatted_print_options (&opts, format);
 925
 926   return ada_varobj_get_value_of_variable (var->value.get (), var->type,
 927                                            &opts);
 928 }
 929
 930 /* Implement the "value_is_changeable_p" routine for Ada.  */
 931
 932 static bool
 933 ada_value_is_changeable_p (const struct varobj *var)
 934 {
 935   struct type *type = (var->value != nullptr
 936                        ? value_type (var->value.get ()) : var->type);
 937
 938   if (TYPE_CODE (type) == TYPE_CODE_REF)
 939     type = TYPE_TARGET_TYPE (type);
 940
 941   if (ada_is_access_to_unconstrained_array (type))
 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 };