gdb/ada-varobj.c

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