gdb/ada-varobj.c

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