gdb/ada-varobj.c

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