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