gdb/ada-varobj.c

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