Upgrade GDB from 7.4.1 to 7.6.1 on the vendor branch
[dragonfly.git] / contrib / gdb-7 / gdb / ada-varobj.c
1 /* varobj support for Ada.
2
3    Copyright (C) 2012-2013 Free Software Foundation, Inc.
4
5    This file is part of GDB.
6
7    This program is free software; you can redistribute it and/or modify
8    it under the terms of the GNU General Public License as published by
9    the Free Software Foundation; either version 3 of the License, or
10    (at your option) any later version.
11
12    This program is distributed in the hope that it will be useful,
13    but WITHOUT ANY WARRANTY; without even the implied warranty of
14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15    GNU General Public License for more details.
16
17    You should have received a copy of the GNU General Public License
18    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
19
20 #include "defs.h"
21 #include "ada-varobj.h"
22 #include "ada-lang.h"
23 #include "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
231   if (!get_array_bounds (parent_type, &lo, &hi))
232     {
233       /* Could not get the array bounds.  Pretend this is an empty array.  */
234       warning (_("unable to get bounds of array, assuming null array"));
235       return 0;
236     }
237
238   /* Ada allows the upper bound to be less than the lower bound,
239      in order to specify empty arrays...  */
240   if (hi < lo)
241     return 0;
242
243   return hi - lo + 1;
244 }
245
246 /* Assuming that the (PARENT_VALUE, PARENT_TYPE) pair is a struct or
247    union, return the number of children this struct contains.  */
248
249 static int
250 ada_varobj_get_struct_number_of_children (struct value *parent_value,
251                                           struct type *parent_type)
252 {
253   int n_children = 0;
254   int i;
255
256   gdb_assert (TYPE_CODE (parent_type) == TYPE_CODE_STRUCT
257               || TYPE_CODE (parent_type) == TYPE_CODE_UNION);
258
259   for (i = 0; i < TYPE_NFIELDS (parent_type); i++)
260     {
261       if (ada_is_ignored_field (parent_type, i))
262         continue;
263
264       if (ada_is_wrapper_field (parent_type, i))
265         {
266           struct value *elt_value;
267           struct type *elt_type;
268
269           ada_varobj_struct_elt (parent_value, parent_type, i,
270                                  &elt_value, &elt_type);
271           if (ada_is_tagged_type (elt_type, 0))
272             {
273               /* We must not use ada_varobj_get_number_of_children
274                  to determine is element's number of children, because
275                  this function first calls ada_varobj_decode_var,
276                  which "fixes" the element.  For tagged types, this
277                  includes reading the object's tag to determine its
278                  real type, which happens to be the parent_type, and
279                  leads to an infinite loop (because the element gets
280                  fixed back into the parent).  */
281               n_children += ada_varobj_get_struct_number_of_children
282                 (elt_value, elt_type);
283             }
284           else
285             n_children += ada_varobj_get_number_of_children (elt_value, elt_type);
286         }
287       else if (ada_is_variant_part (parent_type, i))
288         {
289           /* In normal situations, the variant part of the record should
290              have been "fixed". Or, in other words, it should have been
291              replaced by the branch of the variant part that is relevant
292              for our value.  But there are still situations where this
293              can happen, however (Eg. when our parent is a NULL pointer).
294              We do not support showing this part of the record for now,
295              so just pretend this field does not exist.  */
296         }
297       else
298         n_children++;
299     }
300
301   return n_children;
302 }
303
304 /* Assuming that the (PARENT_VALUE, PARENT_TYPE) pair designates
305    a pointer, return the number of children this pointer has.  */
306
307 static int
308 ada_varobj_get_ptr_number_of_children (struct value *parent_value,
309                                        struct type *parent_type)
310 {
311   struct type *child_type = TYPE_TARGET_TYPE (parent_type);
312
313   /* Pointer to functions and to void do not have a child, since
314      you cannot print what they point to.  */
315   if (TYPE_CODE (child_type) == TYPE_CODE_FUNC
316       || TYPE_CODE (child_type) == TYPE_CODE_VOID)
317     return 0;
318
319   /* All other types have 1 child.  */
320   return 1;
321 }
322
323 /* Return the number of children for the (PARENT_VALUE, PARENT_TYPE)
324    pair.  */
325
326 int
327 ada_varobj_get_number_of_children (struct value *parent_value,
328                                    struct type *parent_type)
329 {
330   ada_varobj_decode_var (&parent_value, &parent_type);
331   ada_varobj_adjust_for_child_access (&parent_value, &parent_type);
332
333   /* A typedef to an array descriptor in fact represents a pointer
334      to an unconstrained array.  These types always have one child
335      (the unconstrained array).  */
336   if (ada_is_array_descriptor_type (parent_type)
337       && TYPE_CODE (parent_type) == TYPE_CODE_TYPEDEF)
338     return 1;
339
340   if (TYPE_CODE (parent_type) == TYPE_CODE_ARRAY)
341     return ada_varobj_get_array_number_of_children (parent_value,
342                                                     parent_type);
343
344   if (TYPE_CODE (parent_type) == TYPE_CODE_STRUCT
345       || TYPE_CODE (parent_type) == TYPE_CODE_UNION)
346     return ada_varobj_get_struct_number_of_children (parent_value,
347                                                      parent_type);
348
349   if (TYPE_CODE (parent_type) == TYPE_CODE_PTR)
350     return ada_varobj_get_ptr_number_of_children (parent_value,
351                                                   parent_type);
352
353   /* All other types have no child.  */
354   return 0;
355 }
356
357 /* Describe the child of the (PARENT_VALUE, PARENT_TYPE) pair
358    whose index is CHILD_INDEX:
359
360      - If CHILD_NAME is not NULL, then a copy of the child's name
361        is saved in *CHILD_NAME.  This copy must be deallocated
362        with xfree after use.
363
364      - If CHILD_VALUE is not NULL, then save the child's value
365        in *CHILD_VALUE. Same thing for the child's type with
366        CHILD_TYPE if not NULL.
367
368      - If CHILD_PATH_EXPR is not NULL, then compute the child's
369        path expression.  The resulting string must be deallocated
370        after use with xfree.
371
372        Computing the child's path expression requires the PARENT_PATH_EXPR
373        to be non-NULL.  Otherwise, PARENT_PATH_EXPR may be null if
374        CHILD_PATH_EXPR is NULL.
375
376   PARENT_NAME is the name of the parent, and should never be NULL.  */
377
378 static void ada_varobj_describe_child (struct value *parent_value,
379                                        struct type *parent_type,
380                                        const char *parent_name,
381                                        const char *parent_path_expr,
382                                        int child_index,
383                                        char **child_name,
384                                        struct value **child_value,
385                                        struct type **child_type,
386                                        char **child_path_expr);
387
388 /* Same as ada_varobj_describe_child, but limited to struct/union
389    objects.  */
390
391 static void
392 ada_varobj_describe_struct_child (struct value *parent_value,
393                                   struct type *parent_type,
394                                   const char *parent_name,
395                                   const char *parent_path_expr,
396                                   int child_index,
397                                   char **child_name,
398                                   struct value **child_value,
399                                   struct type **child_type,
400                                   char **child_path_expr)
401 {
402   int fieldno;
403   int childno = 0;
404
405   gdb_assert (TYPE_CODE (parent_type) == TYPE_CODE_STRUCT);
406
407   for (fieldno = 0; fieldno < TYPE_NFIELDS (parent_type); fieldno++)
408     {
409       if (ada_is_ignored_field (parent_type, fieldno))
410         continue;
411
412       if (ada_is_wrapper_field (parent_type, fieldno))
413         {
414           struct value *elt_value;
415           struct type *elt_type;
416           int elt_n_children;
417
418           ada_varobj_struct_elt (parent_value, parent_type, fieldno,
419                                  &elt_value, &elt_type);
420           if (ada_is_tagged_type (elt_type, 0))
421             {
422               /* Same as in ada_varobj_get_struct_number_of_children:
423                  For tagged types, we must be careful to not call
424                  ada_varobj_get_number_of_children, to prevent our
425                  element from being fixed back into the parent.  */
426               elt_n_children = ada_varobj_get_struct_number_of_children
427                 (elt_value, elt_type);
428             }
429           else
430             elt_n_children =
431               ada_varobj_get_number_of_children (elt_value, elt_type);
432
433           /* Is the child we're looking for one of the children
434              of this wrapper field?  */
435           if (child_index - childno < elt_n_children)
436             {
437               if (ada_is_tagged_type (elt_type, 0))
438                 {
439                   /* Same as in ada_varobj_get_struct_number_of_children:
440                      For tagged types, we must be careful to not call
441                      ada_varobj_describe_child, to prevent our element
442                      from being fixed back into the parent.  */
443                   ada_varobj_describe_struct_child
444                     (elt_value, elt_type, parent_name, parent_path_expr,
445                      child_index - childno, child_name, child_value,
446                      child_type, child_path_expr);
447                 }
448               else
449                 ada_varobj_describe_child (elt_value, elt_type,
450                                            parent_name, parent_path_expr,
451                                            child_index - childno,
452                                            child_name, child_value,
453                                            child_type, child_path_expr);
454               return;
455             }
456
457           /* The child we're looking for is beyond this wrapper
458              field, so skip all its children.  */
459           childno += elt_n_children;
460           continue;
461         }
462       else if (ada_is_variant_part (parent_type, fieldno))
463         {
464           /* In normal situations, the variant part of the record should
465              have been "fixed". Or, in other words, it should have been
466              replaced by the branch of the variant part that is relevant
467              for our value.  But there are still situations where this
468              can happen, however (Eg. when our parent is a NULL pointer).
469              We do not support showing this part of the record for now,
470              so just pretend this field does not exist.  */
471           continue;
472         }
473
474       if (childno == child_index)
475         {
476           if (child_name)
477             {
478               /* The name of the child is none other than the field's
479                  name, except that we need to strip suffixes from it.
480                  For instance, fields with alignment constraints will
481                  have an __XVA suffix added to them.  */
482               const char *field_name = TYPE_FIELD_NAME (parent_type, fieldno);
483               int child_name_len = ada_name_prefix_len (field_name);
484
485               *child_name = xstrprintf ("%.*s", child_name_len, field_name);
486             }
487
488           if (child_value && parent_value)
489             ada_varobj_struct_elt (parent_value, parent_type, fieldno,
490                                    child_value, NULL);
491
492           if (child_type)
493             ada_varobj_struct_elt (parent_value, parent_type, fieldno,
494                                    NULL, child_type);
495
496           if (child_path_expr)
497             {
498               /* The name of the child is none other than the field's
499                  name, except that we need to strip suffixes from it.
500                  For instance, fields with alignment constraints will
501                  have an __XVA suffix added to them.  */
502               const char *field_name = TYPE_FIELD_NAME (parent_type, fieldno);
503               int child_name_len = ada_name_prefix_len (field_name);
504
505               *child_path_expr =
506                 xstrprintf ("(%s).%.*s", parent_path_expr,
507                             child_name_len, field_name);
508             }
509
510           return;
511         }
512
513       childno++;
514     }
515
516   /* Something went wrong.  Either we miscounted the number of
517      children, or CHILD_INDEX was too high.  But we should never
518      reach here.  We don't have enough information to recover
519      nicely, so just raise an assertion failure.  */
520   gdb_assert_not_reached ("unexpected code path");
521 }
522
523 /* Same as ada_varobj_describe_child, but limited to pointer objects.
524
525    Note that CHILD_INDEX is unused in this situation, but still provided
526    for consistency of interface with other routines describing an object's
527    child.  */
528
529 static void
530 ada_varobj_describe_ptr_child (struct value *parent_value,
531                                struct type *parent_type,
532                                const char *parent_name,
533                                const char *parent_path_expr,
534                                int child_index,
535                                char **child_name,
536                                struct value **child_value,
537                                struct type **child_type,
538                                char **child_path_expr)
539 {
540   if (child_name)
541     *child_name = xstrprintf ("%s.all", parent_name);
542
543   if (child_value && parent_value)
544     ada_varobj_ind (parent_value, parent_type, child_value, NULL);
545
546   if (child_type)
547     ada_varobj_ind (parent_value, parent_type, NULL, child_type);
548
549   if (child_path_expr)
550     *child_path_expr = xstrprintf ("(%s).all", parent_path_expr);
551 }
552
553 /* Same as ada_varobj_describe_child, limited to simple array objects
554    (TYPE_CODE_ARRAY only).
555
556    Assumes that the (PARENT_VALUE, PARENT_TYPE) pair is properly decoded.
557    This is done by ada_varobj_describe_child before calling us.  */
558
559 static void
560 ada_varobj_describe_simple_array_child (struct value *parent_value,
561                                         struct type *parent_type,
562                                         const char *parent_name,
563                                         const char *parent_path_expr,
564                                         int child_index,
565                                         char **child_name,
566                                         struct value **child_value,
567                                         struct type **child_type,
568                                         char **child_path_expr)
569 {
570   struct type *index_desc_type;
571   struct type *index_type;
572   int real_index;
573
574   gdb_assert (TYPE_CODE (parent_type) == TYPE_CODE_ARRAY);
575
576   index_desc_type = ada_find_parallel_type (parent_type, "___XA");
577   ada_fixup_array_indexes_type (index_desc_type);
578   if (index_desc_type)
579     index_type = TYPE_FIELD_TYPE (index_desc_type, 0);
580   else
581     index_type = TYPE_INDEX_TYPE (parent_type);
582   real_index = child_index + ada_discrete_type_low_bound (index_type);
583
584   if (child_name)
585     *child_name = ada_varobj_scalar_image (index_type, real_index);
586
587   if (child_value && parent_value)
588     ada_varobj_simple_array_elt (parent_value, parent_type, real_index,
589                                  child_value, NULL);
590
591   if (child_type)
592     ada_varobj_simple_array_elt (parent_value, parent_type, real_index,
593                                  NULL, child_type);
594
595   if (child_path_expr)
596     {
597       char *index_img = ada_varobj_scalar_image (index_type, real_index);
598       struct cleanup *cleanups = make_cleanup (xfree, index_img);
599
600       /* Enumeration litterals by themselves are potentially ambiguous.
601          For instance, consider the following package spec:
602
603             package Pck is
604                type Color is (Red, Green, Blue, White);
605                type Blood_Cells is (White, Red);
606             end Pck;
607
608          In this case, the litteral "red" for instance, or even
609          the fully-qualified litteral "pck.red" cannot be resolved
610          by itself.  Type qualification is needed to determine which
611          enumeration litterals should be used.
612
613          The following variable will be used to contain the name
614          of the array index type when such type qualification is
615          needed.  */
616       const char *index_type_name = NULL;
617
618       /* If the index type is a range type, find the base type.  */
619       while (TYPE_CODE (index_type) == TYPE_CODE_RANGE)
620         index_type = TYPE_TARGET_TYPE (index_type);
621
622       if (TYPE_CODE (index_type) == TYPE_CODE_ENUM
623           || TYPE_CODE (index_type) == TYPE_CODE_BOOL)
624         {
625           index_type_name = ada_type_name (index_type);
626           if (index_type_name)
627             index_type_name = ada_decode (index_type_name);
628         }
629
630       if (index_type_name != NULL)
631         *child_path_expr =
632           xstrprintf ("(%s)(%.*s'(%s))", parent_path_expr,
633                       ada_name_prefix_len (index_type_name),
634                       index_type_name, index_img);
635       else
636         *child_path_expr =
637           xstrprintf ("(%s)(%s)", parent_path_expr, index_img);
638       do_cleanups (cleanups);
639     }
640 }
641
642 /* See description at declaration above.  */
643
644 static void
645 ada_varobj_describe_child (struct value *parent_value,
646                            struct type *parent_type,
647                            const char *parent_name,
648                            const char *parent_path_expr,
649                            int child_index,
650                            char **child_name,
651                            struct value **child_value,
652                            struct type **child_type,
653                            char **child_path_expr)
654 {
655   /* We cannot compute the child's path expression without
656      the parent's path expression.  This is a pre-condition
657      for calling this function.  */
658   if (child_path_expr)
659     gdb_assert (parent_path_expr != NULL);
660
661   ada_varobj_decode_var (&parent_value, &parent_type);
662   ada_varobj_adjust_for_child_access (&parent_value, &parent_type);
663
664   if (child_name)
665     *child_name = NULL;
666   if (child_value)
667     *child_value = NULL;
668   if (child_type)
669     *child_type = NULL;
670   if (child_path_expr)
671     *child_path_expr = NULL;
672
673   if (ada_is_array_descriptor_type (parent_type)
674       && TYPE_CODE (parent_type) == TYPE_CODE_TYPEDEF)
675     {
676       ada_varobj_describe_ptr_child (parent_value, parent_type,
677                                      parent_name, parent_path_expr,
678                                      child_index, child_name,
679                                      child_value, child_type,
680                                      child_path_expr);
681       return;
682     }
683
684   if (TYPE_CODE (parent_type) == TYPE_CODE_ARRAY)
685     {
686       ada_varobj_describe_simple_array_child
687         (parent_value, parent_type, parent_name, parent_path_expr,
688          child_index, child_name, child_value, child_type,
689          child_path_expr);
690       return;
691     }
692
693   if (TYPE_CODE (parent_type) == TYPE_CODE_STRUCT)
694     {
695       ada_varobj_describe_struct_child (parent_value, parent_type,
696                                         parent_name, parent_path_expr,
697                                         child_index, child_name,
698                                         child_value, child_type,
699                                         child_path_expr);
700       return;
701     }
702
703   if (TYPE_CODE (parent_type) == TYPE_CODE_PTR)
704     {
705       ada_varobj_describe_ptr_child (parent_value, parent_type,
706                                      parent_name, parent_path_expr,
707                                      child_index, child_name,
708                                      child_value, child_type,
709                                      child_path_expr);
710       return;
711     }
712
713   /* It should never happen.  But rather than crash, report dummy names
714      and return a NULL child_value.  */
715   if (child_name)
716     *child_name = xstrdup ("???");
717 }
718
719 /* Return the name of the child number CHILD_INDEX of the (PARENT_VALUE,
720    PARENT_TYPE) pair.  PARENT_NAME is the name of the PARENT.
721
722    The result should be deallocated after use with xfree.  */
723
724 char *
725 ada_varobj_get_name_of_child (struct value *parent_value,
726                               struct type *parent_type,
727                               const char *parent_name, int child_index)
728 {
729   char *child_name;
730
731   ada_varobj_describe_child (parent_value, parent_type, parent_name,
732                              NULL, child_index, &child_name, NULL,
733                              NULL, NULL);
734   return child_name;
735 }
736
737 /* Return the path expression of the child number CHILD_INDEX of
738    the (PARENT_VALUE, PARENT_TYPE) pair.  PARENT_NAME is the name
739    of the parent, and PARENT_PATH_EXPR is the parent's path expression.
740    Both must be non-NULL.
741
742    The result must be deallocated after use with xfree.  */
743
744 char *
745 ada_varobj_get_path_expr_of_child (struct value *parent_value,
746                                    struct type *parent_type,
747                                    const char *parent_name,
748                                    const char *parent_path_expr,
749                                    int child_index)
750 {
751   char *child_path_expr;
752
753   ada_varobj_describe_child (parent_value, parent_type, parent_name,
754                              parent_path_expr, child_index, NULL,
755                              NULL, NULL, &child_path_expr);
756
757   return child_path_expr;
758 }
759
760 /* Return the value of child number CHILD_INDEX of the (PARENT_VALUE,
761    PARENT_TYPE) pair.  PARENT_NAME is the name of the parent.  */
762
763 struct value *
764 ada_varobj_get_value_of_child (struct value *parent_value,
765                                struct type *parent_type,
766                                const char *parent_name, int child_index)
767 {
768   struct value *child_value;
769
770   ada_varobj_describe_child (parent_value, parent_type, parent_name,
771                              NULL, child_index, NULL, &child_value,
772                              NULL, NULL);
773
774   return child_value;
775 }
776
777 /* Return the type of child number CHILD_INDEX of the (PARENT_VALUE,
778    PARENT_TYPE) pair.  */
779
780 struct type *
781 ada_varobj_get_type_of_child (struct value *parent_value,
782                               struct type *parent_type,
783                               int child_index)
784 {
785   struct type *child_type;
786
787   ada_varobj_describe_child (parent_value, parent_type, NULL, NULL,
788                              child_index, NULL, NULL, &child_type, NULL);
789
790   return child_type;
791 }
792
793 /* Return a string that contains the image of the given VALUE, using
794    the print options OPTS as the options for formatting the result.
795
796    The resulting string must be deallocated after use with xfree.  */
797
798 static char *
799 ada_varobj_get_value_image (struct value *value,
800                             struct value_print_options *opts)
801 {
802   char *result;
803   struct ui_file *buffer;
804   struct cleanup *old_chain;
805
806   buffer = mem_fileopen ();
807   old_chain = make_cleanup_ui_file_delete (buffer);
808
809   common_val_print (value, buffer, 0, opts, current_language);
810   result = ui_file_xstrdup (buffer, NULL);
811
812   do_cleanups (old_chain);
813   return result;
814 }
815
816 /* Assuming that the (VALUE, TYPE) pair designates an array varobj,
817    return a string that is suitable for use in the "value" field of
818    the varobj output.  Most of the time, this is the number of elements
819    in the array inside square brackets, but there are situations where
820    it's useful to add more info.
821
822    OPTS are the print options used when formatting the result.
823
824    The result should be deallocated after use using xfree.  */
825
826 static char *
827 ada_varobj_get_value_of_array_variable (struct value *value,
828                                         struct type *type,
829                                         struct value_print_options *opts)
830 {
831   char *result;
832   const int numchild = ada_varobj_get_array_number_of_children (value, type);
833
834   /* If we have a string, provide its contents in the "value" field.
835      Otherwise, the only other way to inspect the contents of the string
836      is by looking at the value of each element, as in any other array,
837      which is not very convenient...  */
838   if (value
839       && ada_is_string_type (type)
840       && (opts->format == 0 || opts->format == 's'))
841     {
842       char *str;
843       struct cleanup *old_chain;
844
845       str = ada_varobj_get_value_image (value, opts);
846       old_chain = make_cleanup (xfree, str);
847       result = xstrprintf ("[%d] %s", numchild, str);
848       do_cleanups (old_chain);
849     }
850   else
851     result = xstrprintf ("[%d]", numchild);
852
853   return result;
854 }
855
856 /* Return a string representation of the (VALUE, TYPE) pair, using
857    the given print options OPTS as our formatting options.  */
858
859 char *
860 ada_varobj_get_value_of_variable (struct value *value,
861                                   struct type *type,
862                                   struct value_print_options *opts)
863 {
864   char *result = NULL;
865
866   ada_varobj_decode_var (&value, &type);
867
868   switch (TYPE_CODE (type))
869     {
870     case TYPE_CODE_STRUCT:
871     case TYPE_CODE_UNION:
872       result = xstrdup ("{...}");
873       break;
874     case TYPE_CODE_ARRAY:
875       result = ada_varobj_get_value_of_array_variable (value, type, opts);
876       break;
877     default:
878       if (!value)
879         result = xstrdup ("");
880       else
881         result = ada_varobj_get_value_image (value, opts);
882       break;
883     }
884
885   return result;
886 }
887
888