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_desc_type;
 583   struct type *index_type;
 584   int real_index;
 585
 586   gdb_assert (TYPE_CODE (parent_type) == TYPE_CODE_ARRAY);
 587
 588   index_desc_type = ada_find_parallel_type (parent_type, "___XA");
 589   ada_fixup_array_indexes_type (index_desc_type);
 590   if (index_desc_type)
 591     index_type = TYPE_FIELD_TYPE (index_desc_type, 0);
 592   else
 593     index_type = TYPE_INDEX_TYPE (parent_type);
 594   real_index = child_index + ada_discrete_type_low_bound (index_type);
 595
 596   if (child_name)
 597     *child_name = ada_varobj_scalar_image (index_type, real_index);
 598
 599   if (child_value && parent_value)
 600     ada_varobj_simple_array_elt (parent_value, parent_type, real_index,
 601                                  child_value, NULL);
 602
 603   if (child_type)
 604     ada_varobj_simple_array_elt (parent_value, parent_type, real_index,
 605                                  NULL, child_type);
 606
 607   if (child_path_expr)
 608     {
 609       char *index_img = ada_varobj_scalar_image (index_type, real_index);
 610       struct cleanup *cleanups = make_cleanup (xfree, index_img);
 611
 612       /* Enumeration litterals by themselves are potentially ambiguous.
 613          For instance, consider the following package spec:
 614
 615             package Pck is
 616                type Color is (Red, Green, Blue, White);
 617                type Blood_Cells is (White, Red);
 618             end Pck;
 619
 620          In this case, the litteral "red" for instance, or even
 621          the fully-qualified litteral "pck.red" cannot be resolved
 622          by itself.  Type qualification is needed to determine which
 623          enumeration litterals should be used.
 624
 625          The following variable will be used to contain the name
 626          of the array index type when such type qualification is
 627          needed.  */
 628       const char *index_type_name = NULL;
 629
 630       /* If the index type is a range type, find the base type.  */
 631       while (TYPE_CODE (index_type) == TYPE_CODE_RANGE)
 632         index_type = TYPE_TARGET_TYPE (index_type);
 633
 634       if (TYPE_CODE (index_type) == TYPE_CODE_ENUM
 635           || TYPE_CODE (index_type) == TYPE_CODE_BOOL)
 636         {
 637           index_type_name = ada_type_name (index_type);
 638           if (index_type_name)
 639             index_type_name = ada_decode (index_type_name);
 640         }
 641
 642       if (index_type_name != NULL)
 643         *child_path_expr =
 644           xstrprintf ("(%s)(%.*s'(%s))", parent_path_expr,
 645                       ada_name_prefix_len (index_type_name),
 646                       index_type_name, index_img);
 647       else
 648         *child_path_expr =
 649           xstrprintf ("(%s)(%s)", parent_path_expr, index_img);
 650       do_cleanups (cleanups);
 651     }
 652 }
 653
 654 /* See description at declaration above.  */
 655
 656 static void
 657 ada_varobj_describe_child (struct value *parent_value,
 658                            struct type *parent_type,
 659                            const char *parent_name,
 660                            const char *parent_path_expr,
 661                            int child_index,
 662                            char **child_name,
 663                            struct value **child_value,
 664                            struct type **child_type,
 665                            char **child_path_expr)
 666 {
 667   /* We cannot compute the child's path expression without
 668      the parent's path expression.  This is a pre-condition
 669      for calling this function.  */
 670   if (child_path_expr)
 671     gdb_assert (parent_path_expr != NULL);
 672
 673   ada_varobj_decode_var (&parent_value, &parent_type);
 674   ada_varobj_adjust_for_child_access (&parent_value, &parent_type);
 675
 676   if (child_name)
 677     *child_name = NULL;
 678   if (child_value)
 679     *child_value = NULL;
 680   if (child_type)
 681     *child_type = NULL;
 682   if (child_path_expr)
 683     *child_path_expr = NULL;
 684
 685   if (ada_is_array_descriptor_type (parent_type)
 686       && TYPE_CODE (parent_type) == TYPE_CODE_TYPEDEF)
 687     {
 688       ada_varobj_describe_ptr_child (parent_value, parent_type,
 689                                      parent_name, parent_path_expr,
 690                                      child_index, child_name,
 691                                      child_value, child_type,
 692                                      child_path_expr);
 693       return;
 694     }
 695
 696   if (TYPE_CODE (parent_type) == TYPE_CODE_ARRAY)
 697     {
 698       ada_varobj_describe_simple_array_child
 699         (parent_value, parent_type, parent_name, parent_path_expr,
 700          child_index, child_name, child_value, child_type,
 701          child_path_expr);
 702       return;
 703     }
 704
 705   if (TYPE_CODE (parent_type) == TYPE_CODE_STRUCT)
 706     {
 707       ada_varobj_describe_struct_child (parent_value, parent_type,
 708                                         parent_name, parent_path_expr,
 709                                         child_index, child_name,
 710                                         child_value, child_type,
 711                                         child_path_expr);
 712       return;
 713     }
 714
 715   if (TYPE_CODE (parent_type) == TYPE_CODE_PTR)
 716     {
 717       ada_varobj_describe_ptr_child (parent_value, parent_type,
 718                                      parent_name, parent_path_expr,
 719                                      child_index, child_name,
 720                                      child_value, child_type,
 721                                      child_path_expr);
 722       return;
 723     }
 724
 725   /* It should never happen.  But rather than crash, report dummy names
 726      and return a NULL child_value.  */
 727   if (child_name)
 728     *child_name = xstrdup ("???");
 729 }
 730
 731 /* Return the name of the child number CHILD_INDEX of the (PARENT_VALUE,
 732    PARENT_TYPE) pair.  PARENT_NAME is the name of the PARENT.
 733
 734    The result should be deallocated after use with xfree.  */
 735
 736 static char *
 737 ada_varobj_get_name_of_child (struct value *parent_value,
 738                               struct type *parent_type,
 739                               const char *parent_name, int child_index)
 740 {
 741   char *child_name;
 742
 743   ada_varobj_describe_child (parent_value, parent_type, parent_name,
 744                              NULL, child_index, &child_name, NULL,
 745                              NULL, NULL);
 746   return child_name;
 747 }
 748
 749 /* Return the path expression of the child number CHILD_INDEX of
 750    the (PARENT_VALUE, PARENT_TYPE) pair.  PARENT_NAME is the name
 751    of the parent, and PARENT_PATH_EXPR is the parent's path expression.
 752    Both must be non-NULL.
 753
 754    The result must be deallocated after use with xfree.  */
 755
 756 static char *
 757 ada_varobj_get_path_expr_of_child (struct value *parent_value,
 758                                    struct type *parent_type,
 759                                    const char *parent_name,
 760                                    const char *parent_path_expr,
 761                                    int child_index)
 762 {
 763   char *child_path_expr;
 764
 765   ada_varobj_describe_child (parent_value, parent_type, parent_name,
 766                              parent_path_expr, child_index, NULL,
 767                              NULL, NULL, &child_path_expr);
 768
 769   return child_path_expr;
 770 }
 771
 772 /* Return the value of child number CHILD_INDEX of the (PARENT_VALUE,
 773    PARENT_TYPE) pair.  PARENT_NAME is the name of the parent.  */
 774
 775 static struct value *
 776 ada_varobj_get_value_of_child (struct value *parent_value,
 777                                struct type *parent_type,
 778                                const char *parent_name, int child_index)
 779 {
 780   struct value *child_value;
 781
 782   ada_varobj_describe_child (parent_value, parent_type, parent_name,
 783                              NULL, child_index, NULL, &child_value,
 784                              NULL, NULL);
 785
 786   return child_value;
 787 }
 788
 789 /* Return the type of child number CHILD_INDEX of the (PARENT_VALUE,
 790    PARENT_TYPE) pair.  */
 791
 792 static struct type *
 793 ada_varobj_get_type_of_child (struct value *parent_value,
 794                               struct type *parent_type,
 795                               int child_index)
 796 {
 797   struct type *child_type;
 798
 799   ada_varobj_describe_child (parent_value, parent_type, NULL, NULL,
 800                              child_index, NULL, NULL, &child_type, NULL);
 801
 802   return child_type;
 803 }
 804
 805 /* Return a string that contains the image of the given VALUE, using
 806    the print options OPTS as the options for formatting the result.
 807
 808    The resulting string must be deallocated after use with xfree.  */
 809
 810 static char *
 811 ada_varobj_get_value_image (struct value *value,
 812                             struct value_print_options *opts)
 813 {
 814   char *result;
 815   struct ui_file *buffer;
 816   struct cleanup *old_chain;
 817
 818   buffer = mem_fileopen ();
 819   old_chain = make_cleanup_ui_file_delete (buffer);
 820
 821   common_val_print (value, buffer, 0, opts, current_language);
 822   result = ui_file_xstrdup (buffer, NULL);
 823
 824   do_cleanups (old_chain);
 825   return result;
 826 }
 827
 828 /* Assuming that the (VALUE, TYPE) pair designates an array varobj,
 829    return a string that is suitable for use in the "value" field of
 830    the varobj output.  Most of the time, this is the number of elements
 831    in the array inside square brackets, but there are situations where
 832    it's useful to add more info.
 833
 834    OPTS are the print options used when formatting the result.
 835
 836    The result should be deallocated after use using xfree.  */
 837
 838 static char *
 839 ada_varobj_get_value_of_array_variable (struct value *value,
 840                                         struct type *type,
 841                                         struct value_print_options *opts)
 842 {
 843   char *result;
 844   const int numchild = ada_varobj_get_array_number_of_children (value, type);
 845
 846   /* If we have a string, provide its contents in the "value" field.
 847      Otherwise, the only other way to inspect the contents of the string
 848      is by looking at the value of each element, as in any other array,
 849      which is not very convenient...  */
 850   if (value
 851       && ada_is_string_type (type)
 852       && (opts->format == 0 || opts->format == 's'))
 853     {
 854       char *str;
 855       struct cleanup *old_chain;
 856
 857       str = ada_varobj_get_value_image (value, opts);
 858       old_chain = make_cleanup (xfree, str);
 859       result = xstrprintf ("[%d] %s", numchild, str);
 860       do_cleanups (old_chain);
 861     }
 862   else
 863     result = xstrprintf ("[%d]", numchild);
 864
 865   return result;
 866 }
 867
 868 /* Return a string representation of the (VALUE, TYPE) pair, using
 869    the given print options OPTS as our formatting options.  */
 870
 871 static char *
 872 ada_varobj_get_value_of_variable (struct value *value,
 873                                   struct type *type,
 874                                   struct value_print_options *opts)
 875 {
 876   char *result = NULL;
 877
 878   ada_varobj_decode_var (&value, &type);
 879
 880   switch (TYPE_CODE (type))
 881     {
 882     case TYPE_CODE_STRUCT:
 883     case TYPE_CODE_UNION:
 884       result = xstrdup ("{...}");
 885       break;
 886     case TYPE_CODE_ARRAY:
 887       result = ada_varobj_get_value_of_array_variable (value, type, opts);
 888       break;
 889     default:
 890       if (!value)
 891         result = xstrdup ("");
 892       else
 893         result = ada_varobj_get_value_image (value, opts);
 894       break;
 895     }
 896
 897   return result;
 898 }
 899
 900 /* Ada specific callbacks for VAROBJs.  */
 901
 902 static int
 903 ada_number_of_children (struct varobj *var)
 904 {
 905   return ada_varobj_get_number_of_children (var->value, var->type);
 906 }
 907
 908 static char *
 909 ada_name_of_variable (struct varobj *parent)
 910 {
 911   return c_varobj_ops.name_of_variable (parent);
 912 }
 913
 914 static char *
 915 ada_name_of_child (struct varobj *parent, int index)
 916 {
 917   return ada_varobj_get_name_of_child (parent->value, parent->type,
 918                                        parent->name, index);
 919 }
 920
 921 static char*
 922 ada_path_expr_of_child (struct varobj *child)
 923 {
 924   struct varobj *parent = child->parent;
 925   const char *parent_path_expr = varobj_get_path_expr (parent);
 926
 927   return ada_varobj_get_path_expr_of_child (parent->value,
 928                                             parent->type,
 929                                             parent->name,
 930                                             parent_path_expr,
 931                                             child->index);
 932 }
 933
 934 static struct value *
 935 ada_value_of_child (struct varobj *parent, int index)
 936 {
 937   return ada_varobj_get_value_of_child (parent->value, parent->type,
 938                                         parent->name, index);
 939 }
 940
 941 static struct type *
 942 ada_type_of_child (struct varobj *parent, int index)
 943 {
 944   return ada_varobj_get_type_of_child (parent->value, parent->type,
 945                                        index);
 946 }
 947
 948 static char *
 949 ada_value_of_variable (struct varobj *var, enum varobj_display_formats format)
 950 {
 951   struct value_print_options opts;
 952
 953   varobj_formatted_print_options (&opts, format);
 954
 955   return ada_varobj_get_value_of_variable (var->value, var->type, &opts);
 956 }
 957
 958 /* Implement the "value_is_changeable_p" routine for Ada.  */
 959
 960 static int
 961 ada_value_is_changeable_p (struct varobj *var)
 962 {
 963   struct type *type = var->value ? value_type (var->value) : var->type;
 964
 965   if (ada_is_array_descriptor_type (type)
 966       && TYPE_CODE (type) == TYPE_CODE_TYPEDEF)
 967     {
 968       /* This is in reality a pointer to an unconstrained array.
 969          its value is changeable.  */
 970       return 1;
 971     }
 972
 973   if (ada_is_string_type (type))
 974     {
 975       /* We display the contents of the string in the array's
 976          "value" field.  The contents can change, so consider
 977          that the array is changeable.  */
 978       return 1;
 979     }
 980
 981   return varobj_default_value_is_changeable_p (var);
 982 }
 983
 984 /* Implement the "value_has_mutated" routine for Ada.  */
 985
 986 static int
 987 ada_value_has_mutated (struct varobj *var, struct value *new_val,
 988                        struct type *new_type)
 989 {
 990   int i;
 991   int from = -1;
 992   int to = -1;
 993
 994   /* If the number of fields have changed, then for sure the type
 995      has mutated.  */
 996   if (ada_varobj_get_number_of_children (new_val, new_type)
 997       != var->num_children)
 998     return 1;
 999
1000   /* If the number of fields have remained the same, then we need
1001      to check the name of each field.  If they remain the same,
1002      then chances are the type hasn't mutated.  This is technically
1003      an incomplete test, as the child's type might have changed
1004      despite the fact that the name remains the same.  But we'll
1005      handle this situation by saying that the child has mutated,
1006      not this value.
1007
1008      If only part (or none!) of the children have been fetched,
1009      then only check the ones we fetched.  It does not matter
1010      to the frontend whether a child that it has not fetched yet
1011      has mutated or not. So just assume it hasn't.  */
1012
1013   varobj_restrict_range (var->children, &from, &to);
1014   for (i = from; i < to; i++)
1015     if (strcmp (ada_varobj_get_name_of_child (new_val, new_type,
1016                                               var->name, i),
1017                 VEC_index (varobj_p, var->children, i)->name) != 0)
1018       return 1;
1019
1020   return 0;
1021 }
1022
1023 /* varobj operations for ada.  */
1024
1025 const struct lang_varobj_ops ada_varobj_ops =
1026 {
1027   ada_number_of_children,
1028   ada_name_of_variable,
1029   ada_name_of_child,
1030   ada_path_expr_of_child,
1031   ada_value_of_child,
1032   ada_type_of_child,
1033   ada_value_of_variable,
1034   ada_value_is_changeable_p,
1035   ada_value_has_mutated
1036 };