1 /* varobj support for Ada.
3 Copyright (C) 2012-2014 Free Software Foundation, Inc.
5 This file is part of GDB.
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.
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.
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/>. */
26 /* Implementation principle used in this unit:
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.
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.
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. */
51 static int ada_varobj_get_number_of_children (struct value
*parent_value
,
52 struct type
*parent_type
);
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
60 The results are written in place. */
63 ada_varobj_decode_var (struct value
**value_ptr
, struct type
**type_ptr
)
67 *value_ptr
= ada_get_decoded_value (*value_ptr
);
68 *type_ptr
= ada_check_typedef (value_type (*value_ptr
));
71 *type_ptr
= ada_get_decoded_type (*type_ptr
);
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.
79 The result should be deallocated by xfree after use. */
82 ada_varobj_scalar_image (struct type
*type
, LONGEST val
)
84 struct ui_file
*buf
= mem_fileopen ();
85 struct cleanup
*cleanups
= make_cleanup_ui_file_delete (buf
);
88 ada_print_scalar (type
, val
, buf
);
89 result
= ui_file_xstrdup (buf
, NULL
);
90 do_cleanups (cleanups
);
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. */
100 ada_varobj_struct_elt (struct value
*parent_value
,
101 struct type
*parent_type
,
103 struct value
**child_value
,
104 struct type
**child_type
)
106 struct value
*value
= NULL
;
107 struct type
*type
= NULL
;
111 value
= value_field (parent_value
, fieldno
);
112 type
= value_type (value
);
115 type
= TYPE_FIELD_TYPE (parent_type
, fieldno
);
118 *child_value
= value
;
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. */
128 ada_varobj_ind (struct value
*parent_value
,
129 struct type
*parent_type
,
130 struct value
**child_value
,
131 struct type
**child_type
)
133 struct value
*value
= NULL
;
134 struct type
*type
= NULL
;
136 if (ada_is_array_descriptor_type (parent_type
))
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
);
144 /* Decode parent_type by the equivalent pointer to (decoded)
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
);
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)
159 value
= ada_value_ind (parent_value
);
160 type
= value_type (value
);
163 type
= TYPE_TARGET_TYPE (parent_type
);
166 *child_value
= value
;
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. */
176 ada_varobj_simple_array_elt (struct value
*parent_value
,
177 struct type
*parent_type
,
179 struct value
**child_value
,
180 struct type
**child_type
)
182 struct value
*value
= NULL
;
183 struct type
*type
= NULL
;
187 struct value
*index_value
=
188 value_from_longest (TYPE_INDEX_TYPE (parent_type
), elt_index
);
190 value
= ada_value_subscript (parent_value
, 1, &index_value
);
191 type
= value_type (value
);
194 type
= TYPE_TARGET_TYPE (parent_type
);
197 *child_value
= value
;
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.
206 The replacement is performed in place. */
209 ada_varobj_adjust_for_child_access (struct value
**value
,
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
);
224 /* Assuming that the (PARENT_VALUE, PARENT_TYPE) pair is an array
225 (any type of array, "simple" or not), return the number of children
226 that this array contains. */
229 ada_varobj_get_array_number_of_children (struct value
*parent_value
,
230 struct type
*parent_type
)
234 if (!get_array_bounds (parent_type
, &lo
, &hi
))
236 /* Could not get the array bounds. Pretend this is an empty array. */
237 warning (_("unable to get bounds of array, assuming null array"));
241 /* Ada allows the upper bound to be less than the lower bound,
242 in order to specify empty arrays... */
249 /* Assuming that the (PARENT_VALUE, PARENT_TYPE) pair is a struct or
250 union, return the number of children this struct contains. */
253 ada_varobj_get_struct_number_of_children (struct value
*parent_value
,
254 struct type
*parent_type
)
259 gdb_assert (TYPE_CODE (parent_type
) == TYPE_CODE_STRUCT
260 || TYPE_CODE (parent_type
) == TYPE_CODE_UNION
);
262 for (i
= 0; i
< TYPE_NFIELDS (parent_type
); i
++)
264 if (ada_is_ignored_field (parent_type
, i
))
267 if (ada_is_wrapper_field (parent_type
, i
))
269 struct value
*elt_value
;
270 struct type
*elt_type
;
272 ada_varobj_struct_elt (parent_value
, parent_type
, i
,
273 &elt_value
, &elt_type
);
274 if (ada_is_tagged_type (elt_type
, 0))
276 /* We must not use ada_varobj_get_number_of_children
277 to determine is element's number of children, because
278 this function first calls ada_varobj_decode_var,
279 which "fixes" the element. For tagged types, this
280 includes reading the object's tag to determine its
281 real type, which happens to be the parent_type, and
282 leads to an infinite loop (because the element gets
283 fixed back into the parent). */
284 n_children
+= ada_varobj_get_struct_number_of_children
285 (elt_value
, elt_type
);
288 n_children
+= ada_varobj_get_number_of_children (elt_value
, elt_type
);
290 else if (ada_is_variant_part (parent_type
, i
))
292 /* In normal situations, the variant part of the record should
293 have been "fixed". Or, in other words, it should have been
294 replaced by the branch of the variant part that is relevant
295 for our value. But there are still situations where this
296 can happen, however (Eg. when our parent is a NULL pointer).
297 We do not support showing this part of the record for now,
298 so just pretend this field does not exist. */
307 /* Assuming that the (PARENT_VALUE, PARENT_TYPE) pair designates
308 a pointer, return the number of children this pointer has. */
311 ada_varobj_get_ptr_number_of_children (struct value
*parent_value
,
312 struct type
*parent_type
)
314 struct type
*child_type
= TYPE_TARGET_TYPE (parent_type
);
316 /* Pointer to functions and to void do not have a child, since
317 you cannot print what they point to. */
318 if (TYPE_CODE (child_type
) == TYPE_CODE_FUNC
319 || TYPE_CODE (child_type
) == TYPE_CODE_VOID
)
322 /* All other types have 1 child. */
326 /* Return the number of children for the (PARENT_VALUE, PARENT_TYPE)
330 ada_varobj_get_number_of_children (struct value
*parent_value
,
331 struct type
*parent_type
)
333 ada_varobj_decode_var (&parent_value
, &parent_type
);
334 ada_varobj_adjust_for_child_access (&parent_value
, &parent_type
);
336 /* A typedef to an array descriptor in fact represents a pointer
337 to an unconstrained array. These types always have one child
338 (the unconstrained array). */
339 if (ada_is_array_descriptor_type (parent_type
)
340 && TYPE_CODE (parent_type
) == TYPE_CODE_TYPEDEF
)
343 if (TYPE_CODE (parent_type
) == TYPE_CODE_ARRAY
)
344 return ada_varobj_get_array_number_of_children (parent_value
,
347 if (TYPE_CODE (parent_type
) == TYPE_CODE_STRUCT
348 || TYPE_CODE (parent_type
) == TYPE_CODE_UNION
)
349 return ada_varobj_get_struct_number_of_children (parent_value
,
352 if (TYPE_CODE (parent_type
) == TYPE_CODE_PTR
)
353 return ada_varobj_get_ptr_number_of_children (parent_value
,
356 /* All other types have no child. */
360 /* Describe the child of the (PARENT_VALUE, PARENT_TYPE) pair
361 whose index is CHILD_INDEX:
363 - If CHILD_NAME is not NULL, then a copy of the child's name
364 is saved in *CHILD_NAME. This copy must be deallocated
365 with xfree after use.
367 - If CHILD_VALUE is not NULL, then save the child's value
368 in *CHILD_VALUE. Same thing for the child's type with
369 CHILD_TYPE if not NULL.
371 - If CHILD_PATH_EXPR is not NULL, then compute the child's
372 path expression. The resulting string must be deallocated
373 after use with xfree.
375 Computing the child's path expression requires the PARENT_PATH_EXPR
376 to be non-NULL. Otherwise, PARENT_PATH_EXPR may be null if
377 CHILD_PATH_EXPR is NULL.
379 PARENT_NAME is the name of the parent, and should never be NULL. */
381 static void ada_varobj_describe_child (struct value
*parent_value
,
382 struct type
*parent_type
,
383 const char *parent_name
,
384 const char *parent_path_expr
,
387 struct value
**child_value
,
388 struct type
**child_type
,
389 char **child_path_expr
);
391 /* Same as ada_varobj_describe_child, but limited to struct/union
395 ada_varobj_describe_struct_child (struct value
*parent_value
,
396 struct type
*parent_type
,
397 const char *parent_name
,
398 const char *parent_path_expr
,
401 struct value
**child_value
,
402 struct type
**child_type
,
403 char **child_path_expr
)
408 gdb_assert (TYPE_CODE (parent_type
) == TYPE_CODE_STRUCT
);
410 for (fieldno
= 0; fieldno
< TYPE_NFIELDS (parent_type
); fieldno
++)
412 if (ada_is_ignored_field (parent_type
, fieldno
))
415 if (ada_is_wrapper_field (parent_type
, fieldno
))
417 struct value
*elt_value
;
418 struct type
*elt_type
;
421 ada_varobj_struct_elt (parent_value
, parent_type
, fieldno
,
422 &elt_value
, &elt_type
);
423 if (ada_is_tagged_type (elt_type
, 0))
425 /* Same as in ada_varobj_get_struct_number_of_children:
426 For tagged types, we must be careful to not call
427 ada_varobj_get_number_of_children, to prevent our
428 element from being fixed back into the parent. */
429 elt_n_children
= ada_varobj_get_struct_number_of_children
430 (elt_value
, elt_type
);
434 ada_varobj_get_number_of_children (elt_value
, elt_type
);
436 /* Is the child we're looking for one of the children
437 of this wrapper field? */
438 if (child_index
- childno
< elt_n_children
)
440 if (ada_is_tagged_type (elt_type
, 0))
442 /* Same as in ada_varobj_get_struct_number_of_children:
443 For tagged types, we must be careful to not call
444 ada_varobj_describe_child, to prevent our element
445 from being fixed back into the parent. */
446 ada_varobj_describe_struct_child
447 (elt_value
, elt_type
, parent_name
, parent_path_expr
,
448 child_index
- childno
, child_name
, child_value
,
449 child_type
, child_path_expr
);
452 ada_varobj_describe_child (elt_value
, elt_type
,
453 parent_name
, parent_path_expr
,
454 child_index
- childno
,
455 child_name
, child_value
,
456 child_type
, child_path_expr
);
460 /* The child we're looking for is beyond this wrapper
461 field, so skip all its children. */
462 childno
+= elt_n_children
;
465 else if (ada_is_variant_part (parent_type
, fieldno
))
467 /* In normal situations, the variant part of the record should
468 have been "fixed". Or, in other words, it should have been
469 replaced by the branch of the variant part that is relevant
470 for our value. But there are still situations where this
471 can happen, however (Eg. when our parent is a NULL pointer).
472 We do not support showing this part of the record for now,
473 so just pretend this field does not exist. */
477 if (childno
== child_index
)
481 /* The name of the child is none other than the field's
482 name, except that we need to strip suffixes from it.
483 For instance, fields with alignment constraints will
484 have an __XVA suffix added to them. */
485 const char *field_name
= TYPE_FIELD_NAME (parent_type
, fieldno
);
486 int child_name_len
= ada_name_prefix_len (field_name
);
488 *child_name
= xstrprintf ("%.*s", child_name_len
, field_name
);
491 if (child_value
&& parent_value
)
492 ada_varobj_struct_elt (parent_value
, parent_type
, fieldno
,
496 ada_varobj_struct_elt (parent_value
, parent_type
, fieldno
,
501 /* The name of the child is none other than the field's
502 name, except that we need to strip suffixes from it.
503 For instance, fields with alignment constraints will
504 have an __XVA suffix added to them. */
505 const char *field_name
= TYPE_FIELD_NAME (parent_type
, fieldno
);
506 int child_name_len
= ada_name_prefix_len (field_name
);
509 xstrprintf ("(%s).%.*s", parent_path_expr
,
510 child_name_len
, field_name
);
519 /* Something went wrong. Either we miscounted the number of
520 children, or CHILD_INDEX was too high. But we should never
521 reach here. We don't have enough information to recover
522 nicely, so just raise an assertion failure. */
523 gdb_assert_not_reached ("unexpected code path");
526 /* Same as ada_varobj_describe_child, but limited to pointer objects.
528 Note that CHILD_INDEX is unused in this situation, but still provided
529 for consistency of interface with other routines describing an object's
533 ada_varobj_describe_ptr_child (struct value
*parent_value
,
534 struct type
*parent_type
,
535 const char *parent_name
,
536 const char *parent_path_expr
,
539 struct value
**child_value
,
540 struct type
**child_type
,
541 char **child_path_expr
)
544 *child_name
= xstrprintf ("%s.all", parent_name
);
546 if (child_value
&& parent_value
)
547 ada_varobj_ind (parent_value
, parent_type
, child_value
, NULL
);
550 ada_varobj_ind (parent_value
, parent_type
, NULL
, child_type
);
553 *child_path_expr
= xstrprintf ("(%s).all", parent_path_expr
);
556 /* Same as ada_varobj_describe_child, limited to simple array objects
557 (TYPE_CODE_ARRAY only).
559 Assumes that the (PARENT_VALUE, PARENT_TYPE) pair is properly decoded.
560 This is done by ada_varobj_describe_child before calling us. */
563 ada_varobj_describe_simple_array_child (struct value
*parent_value
,
564 struct type
*parent_type
,
565 const char *parent_name
,
566 const char *parent_path_expr
,
569 struct value
**child_value
,
570 struct type
**child_type
,
571 char **child_path_expr
)
573 struct type
*index_desc_type
;
574 struct type
*index_type
;
577 gdb_assert (TYPE_CODE (parent_type
) == TYPE_CODE_ARRAY
);
579 index_desc_type
= ada_find_parallel_type (parent_type
, "___XA");
580 ada_fixup_array_indexes_type (index_desc_type
);
582 index_type
= TYPE_FIELD_TYPE (index_desc_type
, 0);
584 index_type
= TYPE_INDEX_TYPE (parent_type
);
585 real_index
= child_index
+ ada_discrete_type_low_bound (index_type
);
588 *child_name
= ada_varobj_scalar_image (index_type
, real_index
);
590 if (child_value
&& parent_value
)
591 ada_varobj_simple_array_elt (parent_value
, parent_type
, real_index
,
595 ada_varobj_simple_array_elt (parent_value
, parent_type
, real_index
,
600 char *index_img
= ada_varobj_scalar_image (index_type
, real_index
);
601 struct cleanup
*cleanups
= make_cleanup (xfree
, index_img
);
603 /* Enumeration litterals by themselves are potentially ambiguous.
604 For instance, consider the following package spec:
607 type Color is (Red, Green, Blue, White);
608 type Blood_Cells is (White, Red);
611 In this case, the litteral "red" for instance, or even
612 the fully-qualified litteral "pck.red" cannot be resolved
613 by itself. Type qualification is needed to determine which
614 enumeration litterals should be used.
616 The following variable will be used to contain the name
617 of the array index type when such type qualification is
619 const char *index_type_name
= NULL
;
621 /* If the index type is a range type, find the base type. */
622 while (TYPE_CODE (index_type
) == TYPE_CODE_RANGE
)
623 index_type
= TYPE_TARGET_TYPE (index_type
);
625 if (TYPE_CODE (index_type
) == TYPE_CODE_ENUM
626 || TYPE_CODE (index_type
) == TYPE_CODE_BOOL
)
628 index_type_name
= ada_type_name (index_type
);
630 index_type_name
= ada_decode (index_type_name
);
633 if (index_type_name
!= NULL
)
635 xstrprintf ("(%s)(%.*s'(%s))", parent_path_expr
,
636 ada_name_prefix_len (index_type_name
),
637 index_type_name
, index_img
);
640 xstrprintf ("(%s)(%s)", parent_path_expr
, index_img
);
641 do_cleanups (cleanups
);
645 /* See description at declaration above. */
648 ada_varobj_describe_child (struct value
*parent_value
,
649 struct type
*parent_type
,
650 const char *parent_name
,
651 const char *parent_path_expr
,
654 struct value
**child_value
,
655 struct type
**child_type
,
656 char **child_path_expr
)
658 /* We cannot compute the child's path expression without
659 the parent's path expression. This is a pre-condition
660 for calling this function. */
662 gdb_assert (parent_path_expr
!= NULL
);
664 ada_varobj_decode_var (&parent_value
, &parent_type
);
665 ada_varobj_adjust_for_child_access (&parent_value
, &parent_type
);
674 *child_path_expr
= NULL
;
676 if (ada_is_array_descriptor_type (parent_type
)
677 && TYPE_CODE (parent_type
) == TYPE_CODE_TYPEDEF
)
679 ada_varobj_describe_ptr_child (parent_value
, parent_type
,
680 parent_name
, parent_path_expr
,
681 child_index
, child_name
,
682 child_value
, child_type
,
687 if (TYPE_CODE (parent_type
) == TYPE_CODE_ARRAY
)
689 ada_varobj_describe_simple_array_child
690 (parent_value
, parent_type
, parent_name
, parent_path_expr
,
691 child_index
, child_name
, child_value
, child_type
,
696 if (TYPE_CODE (parent_type
) == TYPE_CODE_STRUCT
)
698 ada_varobj_describe_struct_child (parent_value
, parent_type
,
699 parent_name
, parent_path_expr
,
700 child_index
, child_name
,
701 child_value
, child_type
,
706 if (TYPE_CODE (parent_type
) == TYPE_CODE_PTR
)
708 ada_varobj_describe_ptr_child (parent_value
, parent_type
,
709 parent_name
, parent_path_expr
,
710 child_index
, child_name
,
711 child_value
, child_type
,
716 /* It should never happen. But rather than crash, report dummy names
717 and return a NULL child_value. */
719 *child_name
= xstrdup ("???");
722 /* Return the name of the child number CHILD_INDEX of the (PARENT_VALUE,
723 PARENT_TYPE) pair. PARENT_NAME is the name of the PARENT.
725 The result should be deallocated after use with xfree. */
728 ada_varobj_get_name_of_child (struct value
*parent_value
,
729 struct type
*parent_type
,
730 const char *parent_name
, int child_index
)
734 ada_varobj_describe_child (parent_value
, parent_type
, parent_name
,
735 NULL
, child_index
, &child_name
, NULL
,
740 /* Return the path expression of the child number CHILD_INDEX of
741 the (PARENT_VALUE, PARENT_TYPE) pair. PARENT_NAME is the name
742 of the parent, and PARENT_PATH_EXPR is the parent's path expression.
743 Both must be non-NULL.
745 The result must be deallocated after use with xfree. */
748 ada_varobj_get_path_expr_of_child (struct value
*parent_value
,
749 struct type
*parent_type
,
750 const char *parent_name
,
751 const char *parent_path_expr
,
754 char *child_path_expr
;
756 ada_varobj_describe_child (parent_value
, parent_type
, parent_name
,
757 parent_path_expr
, child_index
, NULL
,
758 NULL
, NULL
, &child_path_expr
);
760 return child_path_expr
;
763 /* Return the value of child number CHILD_INDEX of the (PARENT_VALUE,
764 PARENT_TYPE) pair. PARENT_NAME is the name of the parent. */
766 static struct value
*
767 ada_varobj_get_value_of_child (struct value
*parent_value
,
768 struct type
*parent_type
,
769 const char *parent_name
, int child_index
)
771 struct value
*child_value
;
773 ada_varobj_describe_child (parent_value
, parent_type
, parent_name
,
774 NULL
, child_index
, NULL
, &child_value
,
780 /* Return the type of child number CHILD_INDEX of the (PARENT_VALUE,
781 PARENT_TYPE) pair. */
784 ada_varobj_get_type_of_child (struct value
*parent_value
,
785 struct type
*parent_type
,
788 struct type
*child_type
;
790 ada_varobj_describe_child (parent_value
, parent_type
, NULL
, NULL
,
791 child_index
, NULL
, NULL
, &child_type
, NULL
);
796 /* Return a string that contains the image of the given VALUE, using
797 the print options OPTS as the options for formatting the result.
799 The resulting string must be deallocated after use with xfree. */
802 ada_varobj_get_value_image (struct value
*value
,
803 struct value_print_options
*opts
)
806 struct ui_file
*buffer
;
807 struct cleanup
*old_chain
;
809 buffer
= mem_fileopen ();
810 old_chain
= make_cleanup_ui_file_delete (buffer
);
812 common_val_print (value
, buffer
, 0, opts
, current_language
);
813 result
= ui_file_xstrdup (buffer
, NULL
);
815 do_cleanups (old_chain
);
819 /* Assuming that the (VALUE, TYPE) pair designates an array varobj,
820 return a string that is suitable for use in the "value" field of
821 the varobj output. Most of the time, this is the number of elements
822 in the array inside square brackets, but there are situations where
823 it's useful to add more info.
825 OPTS are the print options used when formatting the result.
827 The result should be deallocated after use using xfree. */
830 ada_varobj_get_value_of_array_variable (struct value
*value
,
832 struct value_print_options
*opts
)
835 const int numchild
= ada_varobj_get_array_number_of_children (value
, type
);
837 /* If we have a string, provide its contents in the "value" field.
838 Otherwise, the only other way to inspect the contents of the string
839 is by looking at the value of each element, as in any other array,
840 which is not very convenient... */
842 && ada_is_string_type (type
)
843 && (opts
->format
== 0 || opts
->format
== 's'))
846 struct cleanup
*old_chain
;
848 str
= ada_varobj_get_value_image (value
, opts
);
849 old_chain
= make_cleanup (xfree
, str
);
850 result
= xstrprintf ("[%d] %s", numchild
, str
);
851 do_cleanups (old_chain
);
854 result
= xstrprintf ("[%d]", numchild
);
859 /* Return a string representation of the (VALUE, TYPE) pair, using
860 the given print options OPTS as our formatting options. */
863 ada_varobj_get_value_of_variable (struct value
*value
,
865 struct value_print_options
*opts
)
869 ada_varobj_decode_var (&value
, &type
);
871 switch (TYPE_CODE (type
))
873 case TYPE_CODE_STRUCT
:
874 case TYPE_CODE_UNION
:
875 result
= xstrdup ("{...}");
877 case TYPE_CODE_ARRAY
:
878 result
= ada_varobj_get_value_of_array_variable (value
, type
, opts
);
882 result
= xstrdup ("");
884 result
= ada_varobj_get_value_image (value
, opts
);
891 /* Ada specific callbacks for VAROBJs. */
894 ada_number_of_children (struct varobj
*var
)
896 return ada_varobj_get_number_of_children (var
->value
, var
->type
);
900 ada_name_of_variable (struct varobj
*parent
)
902 return c_varobj_ops
.name_of_variable (parent
);
906 ada_name_of_child (struct varobj
*parent
, int index
)
908 return ada_varobj_get_name_of_child (parent
->value
, parent
->type
,
909 parent
->name
, index
);
913 ada_path_expr_of_child (struct varobj
*child
)
915 struct varobj
*parent
= child
->parent
;
916 const char *parent_path_expr
= varobj_get_path_expr (parent
);
918 return ada_varobj_get_path_expr_of_child (parent
->value
,
925 static struct value
*
926 ada_value_of_child (struct varobj
*parent
, int index
)
928 return ada_varobj_get_value_of_child (parent
->value
, parent
->type
,
929 parent
->name
, index
);
933 ada_type_of_child (struct varobj
*parent
, int index
)
935 return ada_varobj_get_type_of_child (parent
->value
, parent
->type
,
940 ada_value_of_variable (struct varobj
*var
, enum varobj_display_formats format
)
942 struct value_print_options opts
;
944 varobj_formatted_print_options (&opts
, format
);
946 return ada_varobj_get_value_of_variable (var
->value
, var
->type
, &opts
);
949 /* Implement the "value_is_changeable_p" routine for Ada. */
952 ada_value_is_changeable_p (struct varobj
*var
)
954 struct type
*type
= var
->value
? value_type (var
->value
) : var
->type
;
956 if (ada_is_array_descriptor_type (type
)
957 && TYPE_CODE (type
) == TYPE_CODE_TYPEDEF
)
959 /* This is in reality a pointer to an unconstrained array.
960 its value is changeable. */
964 if (ada_is_string_type (type
))
966 /* We display the contents of the string in the array's
967 "value" field. The contents can change, so consider
968 that the array is changeable. */
972 return varobj_default_value_is_changeable_p (var
);
975 /* Implement the "value_has_mutated" routine for Ada. */
978 ada_value_has_mutated (struct varobj
*var
, struct value
*new_val
,
979 struct type
*new_type
)
985 /* If the number of fields have changed, then for sure the type
987 if (ada_varobj_get_number_of_children (new_val
, new_type
)
988 != var
->num_children
)
991 /* If the number of fields have remained the same, then we need
992 to check the name of each field. If they remain the same,
993 then chances are the type hasn't mutated. This is technically
994 an incomplete test, as the child's type might have changed
995 despite the fact that the name remains the same. But we'll
996 handle this situation by saying that the child has mutated,
999 If only part (or none!) of the children have been fetched,
1000 then only check the ones we fetched. It does not matter
1001 to the frontend whether a child that it has not fetched yet
1002 has mutated or not. So just assume it hasn't. */
1004 varobj_restrict_range (var
->children
, &from
, &to
);
1005 for (i
= from
; i
< to
; i
++)
1006 if (strcmp (ada_varobj_get_name_of_child (new_val
, new_type
,
1008 VEC_index (varobj_p
, var
->children
, i
)->name
) != 0)
1014 /* varobj operations for ada. */
1016 const struct lang_varobj_ops ada_varobj_ops
=
1018 ada_number_of_children
,
1019 ada_name_of_variable
,
1021 ada_path_expr_of_child
,
1024 ada_value_of_variable
,
1025 ada_value_is_changeable_p
,
1026 ada_value_has_mutated