Varobj support for Ada.
[external/binutils.git] / gdb / ada-varobj.c
1 /* varobj support for Ada.
2
3    Copyright (C) 2012 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 "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 /* A convenience function that decodes the VALUE_PTR/TYPE_PTR couple:
52    If there is a value (*VALUE_PTR not NULL), then perform the decoding
53    using it, and compute the associated type from the resulting value.
54    Otherwise, compute a static approximation of *TYPE_PTR, leaving
55    *VALUE_PTR unchanged.
56
57    The results are written in place.  */
58
59 static void
60 ada_varobj_decode_var (struct value **value_ptr, struct type **type_ptr)
61 {
62   if (*value_ptr)
63     {
64       *value_ptr = ada_get_decoded_value (*value_ptr);
65       *type_ptr = ada_check_typedef (value_type (*value_ptr));
66     }
67   else
68     *type_ptr = ada_get_decoded_type (*type_ptr);
69 }
70
71 /* Return a string containing an image of the given scalar value.
72    VAL is the numeric value, while TYPE is the value's type.
73    This is useful for plain integers, of course, but even more
74    so for enumerated types.
75
76    The result should be deallocated by xfree after use.  */
77
78 static char *
79 ada_varobj_scalar_image (struct type *type, LONGEST val)
80 {
81   struct ui_file *buf = mem_fileopen ();
82   struct cleanup *cleanups = make_cleanup_ui_file_delete (buf);
83   char *result;
84
85   ada_print_scalar (type, val, buf);
86   result = ui_file_xstrdup (buf, NULL);
87   do_cleanups (cleanups);
88
89   return result;
90 }
91
92 /* Assuming that the (PARENT_VALUE, PARENT_TYPE) pair designates
93    a struct or union, compute the (CHILD_VALUE, CHILD_TYPE) couple
94    corresponding to the field number FIELDNO.  */
95
96 static void
97 ada_varobj_struct_elt (struct value *parent_value,
98                        struct type *parent_type,
99                        int fieldno,
100                        struct value **child_value,
101                        struct type **child_type)
102 {
103   struct value *value = NULL;
104   struct type *type = NULL;
105
106   if (parent_value)
107     {
108       value = value_field (parent_value, fieldno);
109       type = value_type (value);
110     }
111   else
112     type = TYPE_FIELD_TYPE (parent_type, fieldno);
113
114   if (child_value)
115     *child_value = value;
116   if (child_type)
117     *child_type = type;
118 }
119
120 /* Assuming that the (PARENT_VALUE, PARENT_TYPE) pair is a pointer or
121    reference, return a (CHILD_VALUE, CHILD_TYPE) couple corresponding
122    to the dereferenced value.  */
123
124 static void
125 ada_varobj_ind (struct value *parent_value,
126                 struct type *parent_type,
127                 struct value **child_value,
128                 struct type **child_type)
129 {
130   struct value *value = NULL;
131   struct type *type = NULL;
132
133   if (ada_is_array_descriptor_type (parent_type))
134     {
135       /* This can only happen when PARENT_VALUE is NULL.  Otherwise,
136          ada_get_decoded_value would have transformed our parent_type
137          into a simple array pointer type.  */
138       gdb_assert (parent_value == NULL);
139       gdb_assert (TYPE_CODE (parent_type) == TYPE_CODE_TYPEDEF);
140
141       /* Decode parent_type by the equivalent pointer to (decoded)
142          array.  */
143       while (TYPE_CODE (parent_type) == TYPE_CODE_TYPEDEF)
144         parent_type = TYPE_TARGET_TYPE (parent_type);
145       parent_type = ada_coerce_to_simple_array_type (parent_type);
146       parent_type = lookup_pointer_type (parent_type);
147     }
148
149   /* If parent_value is a null pointer, then only perform static
150      dereferencing.  We cannot dereference null pointers.  */
151   if (parent_value && value_as_address (parent_value) == 0)
152     parent_value = NULL;
153
154   if (parent_value)
155     {
156       value = ada_value_ind (parent_value);
157       type = value_type (value);
158     }
159   else
160     type = TYPE_TARGET_TYPE (parent_type);
161
162   if (child_value)
163     *child_value = value;
164   if (child_type)
165     *child_type = type;
166 }
167
168 /* Assuming that the (PARENT_VALUE, PARENT_TYPE) pair is a simple
169    array (TYPE_CODE_ARRAY), return the (CHILD_VALUE, CHILD_TYPE)
170    pair corresponding to the element at ELT_INDEX.  */
171
172 static void
173 ada_varobj_simple_array_elt (struct value *parent_value,
174                              struct type *parent_type,
175                              int elt_index,
176                              struct value **child_value,
177                              struct type **child_type)
178 {
179   struct value *value = NULL;
180   struct type *type = NULL;
181
182   if (parent_value)
183     {
184       struct value *index_value =
185         value_from_longest (TYPE_INDEX_TYPE (parent_type), elt_index);
186
187       value = ada_value_subscript (parent_value, 1, &index_value);
188       type = value_type (value);
189     }
190   else
191     type = TYPE_TARGET_TYPE (parent_type);
192
193   if (child_value)
194     *child_value = value;
195   if (child_type)
196     *child_type = type;
197 }
198
199 /* Given the decoded value and decoded type of a variable object,
200    adjust the value and type to those necessary for getting children
201    of the variable object.
202
203    The replacement is performed in place.  */
204
205 static void
206 ada_varobj_adjust_for_child_access (struct value **value,
207                                     struct type **type)
208 {
209    /* Pointers to struct/union types are special: Instead of having
210       one child (the struct), their children are the components of
211       the struct/union type.  We handle this situation by dereferencing
212       the (value, type) couple.  */
213   if (TYPE_CODE (*type) == TYPE_CODE_PTR
214       && (TYPE_CODE (TYPE_TARGET_TYPE (*type)) == TYPE_CODE_STRUCT
215           || TYPE_CODE (TYPE_TARGET_TYPE (*type)) == TYPE_CODE_UNION)
216       && !ada_is_array_descriptor_type (TYPE_TARGET_TYPE (*type))
217       && !ada_is_constrained_packed_array_type (TYPE_TARGET_TYPE (*type)))
218     ada_varobj_ind (*value, *type, value, type);
219 }
220
221 /* Assuming that the (PARENT_VALUE, PARENT_TYPE) pair is an array
222    (any type of array, "simple" or not), return the number of children
223    that this array contains.  */
224
225 static int
226 ada_varobj_get_array_number_of_children (struct value *parent_value,
227                                          struct type *parent_type)
228 {
229   LONGEST lo, hi;
230   int len;
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