Automatic date update in version.in
[binutils-gdb.git] / gdb / ada-varobj.c
blob21412dbf22007c44718f6c67c42673ea39c4bd8e
1 /* varobj support for Ada.
3 Copyright (C) 2012-2024 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/>. */
20 #include "ada-lang.h"
21 #include "varobj.h"
22 #include "language.h"
23 #include "valprint.h"
25 /* Implementation principle used in this unit:
27 For our purposes, the meat of the varobj object is made of two
28 elements: The varobj's (struct) value, and the varobj's (struct)
29 type. In most situations, the varobj has a non-NULL value, and
30 the type becomes redundant, as it can be directly derived from
31 the value. In the initial implementation of this unit, most
32 routines would only take a value, and return a value.
34 But there are many situations where it is possible for a varobj
35 to have a NULL value. For instance, if the varobj becomes out of
36 scope. Or better yet, when the varobj is the child of another
37 NULL pointer varobj. In that situation, we must rely on the type
38 instead of the value to create the child varobj.
40 That's why most functions below work with a (value, type) pair.
41 The value may or may not be NULL. But the type is always expected
42 to be set. When the value is NULL, then we work with the type
43 alone, and keep the value NULL. But when the value is not NULL,
44 then we work using the value, because it provides more information.
45 But we still always set the type as well, even if that type could
46 easily be derived from the value. The reason behind this is that
47 it allows the code to use the type without having to worry about
48 it being set or not. It makes the code clearer. */
50 static int ada_varobj_get_number_of_children (struct value *parent_value,
51 struct type *parent_type);
53 /* A convenience function that decodes the VALUE_PTR/TYPE_PTR couple:
54 If there is a value (*VALUE_PTR not NULL), then perform the decoding
55 using it, and compute the associated type from the resulting value.
56 Otherwise, compute a static approximation of *TYPE_PTR, leaving
57 *VALUE_PTR unchanged.
59 The results are written in place. */
61 static void
62 ada_varobj_decode_var (struct value **value_ptr, struct type **type_ptr)
64 if (*value_ptr)
65 *value_ptr = ada_get_decoded_value (*value_ptr);
67 if (*value_ptr != nullptr)
68 *type_ptr = ada_check_typedef ((*value_ptr)->type ());
69 else
70 *type_ptr = ada_get_decoded_type (*type_ptr);
73 /* Return a string containing an image of the given scalar value.
74 VAL is the numeric value, while TYPE is the value's type.
75 This is useful for plain integers, of course, but even more
76 so for enumerated types. */
78 static std::string
79 ada_varobj_scalar_image (struct type *type, LONGEST val)
81 string_file buf;
83 ada_print_scalar (type, val, &buf);
84 return buf.release ();
87 /* Assuming that the (PARENT_VALUE, PARENT_TYPE) pair designates
88 a struct or union, compute the (CHILD_VALUE, CHILD_TYPE) couple
89 corresponding to the field number FIELDNO. */
91 static void
92 ada_varobj_struct_elt (struct value *parent_value,
93 struct type *parent_type,
94 int fieldno,
95 struct value **child_value,
96 struct type **child_type)
98 struct value *value = NULL;
99 struct type *type = NULL;
101 if (parent_value)
103 value = value_field (parent_value, fieldno);
104 type = value->type ();
106 else
107 type = parent_type->field (fieldno).type ();
109 if (child_value)
110 *child_value = value;
111 if (child_type)
112 *child_type = type;
115 /* Assuming that the (PARENT_VALUE, PARENT_TYPE) pair is a pointer or
116 reference, return a (CHILD_VALUE, CHILD_TYPE) couple corresponding
117 to the dereferenced value. */
119 static void
120 ada_varobj_ind (struct value *parent_value,
121 struct type *parent_type,
122 struct value **child_value,
123 struct type **child_type)
125 struct value *value = NULL;
126 struct type *type = NULL;
128 if (ada_is_array_descriptor_type (parent_type))
130 /* This can only happen when PARENT_VALUE is NULL. Otherwise,
131 ada_get_decoded_value would have transformed our parent_type
132 into a simple array pointer type. */
133 gdb_assert (parent_value == NULL);
134 gdb_assert (parent_type->code () == TYPE_CODE_TYPEDEF);
136 /* Decode parent_type by the equivalent pointer to (decoded)
137 array. */
138 while (parent_type->code () == TYPE_CODE_TYPEDEF)
139 parent_type = parent_type->target_type ();
140 parent_type = ada_coerce_to_simple_array_type (parent_type);
141 parent_type = lookup_pointer_type (parent_type);
144 /* If parent_value is a null pointer, then only perform static
145 dereferencing. We cannot dereference null pointers. */
146 if (parent_value && value_as_address (parent_value) == 0)
147 parent_value = NULL;
149 if (parent_value)
151 value = ada_value_ind (parent_value);
152 type = value->type ();
154 else
155 type = parent_type->target_type ();
157 if (child_value)
158 *child_value = value;
159 if (child_type)
160 *child_type = type;
163 /* Assuming that the (PARENT_VALUE, PARENT_TYPE) pair is a simple
164 array (TYPE_CODE_ARRAY), return the (CHILD_VALUE, CHILD_TYPE)
165 pair corresponding to the element at ELT_INDEX. */
167 static void
168 ada_varobj_simple_array_elt (struct value *parent_value,
169 struct type *parent_type,
170 int elt_index,
171 struct value **child_value,
172 struct type **child_type)
174 struct value *value = NULL;
175 struct type *type = NULL;
177 if (parent_value)
179 struct value *index_value =
180 value_from_longest (parent_type->index_type (), elt_index);
182 value = ada_value_subscript (parent_value, 1, &index_value);
183 type = value->type ();
185 else
186 type = parent_type->target_type ();
188 if (child_value)
189 *child_value = value;
190 if (child_type)
191 *child_type = type;
194 /* Given the decoded value and decoded type of a variable object,
195 adjust the value and type to those necessary for getting children
196 of the variable object.
198 The replacement is performed in place. */
200 static void
201 ada_varobj_adjust_for_child_access (struct value **value,
202 struct type **type)
204 /* Pointers to struct/union types are special: Instead of having
205 one child (the struct), their children are the components of
206 the struct/union type. We handle this situation by dereferencing
207 the (value, type) couple. */
208 if ((*type)->code () == TYPE_CODE_PTR
209 && ((*type)->target_type ()->code () == TYPE_CODE_STRUCT
210 || (*type)->target_type ()->code () == TYPE_CODE_UNION)
211 && *value != nullptr
212 && value_as_address (*value) != 0
213 && !ada_is_array_descriptor_type ((*type)->target_type ())
214 && !ada_is_constrained_packed_array_type ((*type)->target_type ()))
215 ada_varobj_ind (*value, *type, value, type);
217 /* If this is a tagged type, we need to transform it a bit in order
218 to be able to fetch its full view. As always with tagged types,
219 we can only do that if we have a value. */
220 if (*value != NULL && ada_is_tagged_type (*type, 1))
222 *value = ada_tag_value_at_base_address (*value);
223 *type = (*value)->type ();
227 /* Assuming that the (PARENT_VALUE, PARENT_TYPE) pair is an array
228 (any type of array, "simple" or not), return the number of children
229 that this array contains. */
231 static int
232 ada_varobj_get_array_number_of_children (struct value *parent_value,
233 struct type *parent_type)
235 LONGEST lo, hi;
237 if (parent_value == NULL
238 && is_dynamic_type (parent_type->index_type ()))
240 /* This happens when listing the children of an object
241 which does not exist in memory (Eg: when requesting
242 the children of a null pointer, which is allowed by
243 varobj). The array index type being dynamic, we cannot
244 determine how many elements this array has. Just assume
245 it has none. */
246 return 0;
249 if (!get_array_bounds (parent_type, &lo, &hi))
251 /* Could not get the array bounds. Pretend this is an empty array. */
252 warning (_("unable to get bounds of array, assuming null array"));
253 return 0;
256 /* Ada allows the upper bound to be less than the lower bound,
257 in order to specify empty arrays... */
258 if (hi < lo)
259 return 0;
261 return hi - lo + 1;
264 /* Assuming that the (PARENT_VALUE, PARENT_TYPE) pair is a struct or
265 union, return the number of children this struct contains. */
267 static int
268 ada_varobj_get_struct_number_of_children (struct value *parent_value,
269 struct type *parent_type)
271 int n_children = 0;
272 int i;
274 gdb_assert (parent_type->code () == TYPE_CODE_STRUCT
275 || parent_type->code () == TYPE_CODE_UNION);
277 for (i = 0; i < parent_type->num_fields (); i++)
279 if (ada_is_ignored_field (parent_type, i))
280 continue;
282 if (ada_is_wrapper_field (parent_type, i))
284 struct value *elt_value;
285 struct type *elt_type;
287 ada_varobj_struct_elt (parent_value, parent_type, i,
288 &elt_value, &elt_type);
289 if (ada_is_tagged_type (elt_type, 0))
291 /* We must not use ada_varobj_get_number_of_children
292 to determine is element's number of children, because
293 this function first calls ada_varobj_decode_var,
294 which "fixes" the element. For tagged types, this
295 includes reading the object's tag to determine its
296 real type, which happens to be the parent_type, and
297 leads to an infinite loop (because the element gets
298 fixed back into the parent). */
299 n_children += ada_varobj_get_struct_number_of_children
300 (elt_value, elt_type);
302 else
303 n_children += ada_varobj_get_number_of_children (elt_value, elt_type);
305 else if (ada_is_variant_part (parent_type, i))
307 /* In normal situations, the variant part of the record should
308 have been "fixed". Or, in other words, it should have been
309 replaced by the branch of the variant part that is relevant
310 for our value. But there are still situations where this
311 can happen, however (Eg. when our parent is a NULL pointer).
312 We do not support showing this part of the record for now,
313 so just pretend this field does not exist. */
315 else
316 n_children++;
319 return n_children;
322 /* Assuming that the (PARENT_VALUE, PARENT_TYPE) pair designates
323 a pointer, return the number of children this pointer has. */
325 static int
326 ada_varobj_get_ptr_number_of_children (struct value *parent_value,
327 struct type *parent_type)
329 struct type *child_type = parent_type->target_type ();
331 /* Pointer to functions and to void do not have a child, since
332 you cannot print what they point to. */
333 if (child_type->code () == TYPE_CODE_FUNC
334 || child_type->code () == TYPE_CODE_VOID)
335 return 0;
337 /* Only show children for non-null pointers. */
338 if (parent_value == nullptr || value_as_address (parent_value) == 0)
339 return 0;
341 /* All other types have 1 child. */
342 return 1;
345 /* Return the number of children for the (PARENT_VALUE, PARENT_TYPE)
346 pair. */
348 static int
349 ada_varobj_get_number_of_children (struct value *parent_value,
350 struct type *parent_type)
352 ada_varobj_decode_var (&parent_value, &parent_type);
353 ada_varobj_adjust_for_child_access (&parent_value, &parent_type);
355 /* A typedef to an array descriptor in fact represents a pointer
356 to an unconstrained array. These types always have one child
357 (the unconstrained array). */
358 if (ada_is_access_to_unconstrained_array (parent_type))
359 return 1;
361 if (parent_type->code () == TYPE_CODE_ARRAY)
362 return ada_varobj_get_array_number_of_children (parent_value,
363 parent_type);
365 if (parent_type->code () == TYPE_CODE_STRUCT
366 || parent_type->code () == TYPE_CODE_UNION)
367 return ada_varobj_get_struct_number_of_children (parent_value,
368 parent_type);
370 if (parent_type->code () == TYPE_CODE_PTR)
371 return ada_varobj_get_ptr_number_of_children (parent_value,
372 parent_type);
374 /* All other types have no child. */
375 return 0;
378 /* Describe the child of the (PARENT_VALUE, PARENT_TYPE) pair
379 whose index is CHILD_INDEX:
381 - If CHILD_NAME is not NULL, then a copy of the child's name
382 is saved in *CHILD_NAME. This copy must be deallocated
383 with xfree after use.
385 - If CHILD_VALUE is not NULL, then save the child's value
386 in *CHILD_VALUE. Same thing for the child's type with
387 CHILD_TYPE if not NULL.
389 - If CHILD_PATH_EXPR is not NULL, then compute the child's
390 path expression. The resulting string must be deallocated
391 after use with xfree.
393 Computing the child's path expression requires the PARENT_PATH_EXPR
394 to be non-NULL. Otherwise, PARENT_PATH_EXPR may be null if
395 CHILD_PATH_EXPR is NULL.
397 PARENT_NAME is the name of the parent, and should never be NULL. */
399 static void ada_varobj_describe_child (struct value *parent_value,
400 struct type *parent_type,
401 const char *parent_name,
402 const char *parent_path_expr,
403 int child_index,
404 std::string *child_name,
405 struct value **child_value,
406 struct type **child_type,
407 std::string *child_path_expr);
409 /* Same as ada_varobj_describe_child, but limited to struct/union
410 objects. */
412 static void
413 ada_varobj_describe_struct_child (struct value *parent_value,
414 struct type *parent_type,
415 const char *parent_name,
416 const char *parent_path_expr,
417 int child_index,
418 std::string *child_name,
419 struct value **child_value,
420 struct type **child_type,
421 std::string *child_path_expr)
423 int fieldno;
424 int childno = 0;
426 gdb_assert (parent_type->code () == TYPE_CODE_STRUCT
427 || parent_type->code () == TYPE_CODE_UNION);
429 for (fieldno = 0; fieldno < parent_type->num_fields (); fieldno++)
431 if (ada_is_ignored_field (parent_type, fieldno))
432 continue;
434 if (ada_is_wrapper_field (parent_type, fieldno))
436 struct value *elt_value;
437 struct type *elt_type;
438 int elt_n_children;
440 ada_varobj_struct_elt (parent_value, parent_type, fieldno,
441 &elt_value, &elt_type);
442 if (ada_is_tagged_type (elt_type, 0))
444 /* Same as in ada_varobj_get_struct_number_of_children:
445 For tagged types, we must be careful to not call
446 ada_varobj_get_number_of_children, to prevent our
447 element from being fixed back into the parent. */
448 elt_n_children = ada_varobj_get_struct_number_of_children
449 (elt_value, elt_type);
451 else
452 elt_n_children =
453 ada_varobj_get_number_of_children (elt_value, elt_type);
455 /* Is the child we're looking for one of the children
456 of this wrapper field? */
457 if (child_index - childno < elt_n_children)
459 if (ada_is_tagged_type (elt_type, 0))
461 /* Same as in ada_varobj_get_struct_number_of_children:
462 For tagged types, we must be careful to not call
463 ada_varobj_describe_child, to prevent our element
464 from being fixed back into the parent. */
465 ada_varobj_describe_struct_child
466 (elt_value, elt_type, parent_name, parent_path_expr,
467 child_index - childno, child_name, child_value,
468 child_type, child_path_expr);
470 else
471 ada_varobj_describe_child (elt_value, elt_type,
472 parent_name, parent_path_expr,
473 child_index - childno,
474 child_name, child_value,
475 child_type, child_path_expr);
476 return;
479 /* The child we're looking for is beyond this wrapper
480 field, so skip all its children. */
481 childno += elt_n_children;
482 continue;
484 else if (ada_is_variant_part (parent_type, fieldno))
486 /* In normal situations, the variant part of the record should
487 have been "fixed". Or, in other words, it should have been
488 replaced by the branch of the variant part that is relevant
489 for our value. But there are still situations where this
490 can happen, however (Eg. when our parent is a NULL pointer).
491 We do not support showing this part of the record for now,
492 so just pretend this field does not exist. */
493 continue;
496 if (childno == child_index)
498 if (child_name)
500 /* The name of the child is none other than the field's
501 name, except that we need to strip suffixes from it.
502 For instance, fields with alignment constraints will
503 have an __XVA suffix added to them. */
504 const char *field_name = parent_type->field (fieldno).name ();
505 int child_name_len = ada_name_prefix_len (field_name);
507 *child_name = string_printf ("%.*s", child_name_len, field_name);
510 if (child_value && parent_value)
511 ada_varobj_struct_elt (parent_value, parent_type, fieldno,
512 child_value, NULL);
514 if (child_type)
515 ada_varobj_struct_elt (parent_value, parent_type, fieldno,
516 NULL, child_type);
518 if (child_path_expr)
520 /* The name of the child is none other than the field's
521 name, except that we need to strip suffixes from it.
522 For instance, fields with alignment constraints will
523 have an __XVA suffix added to them. */
524 const char *field_name = parent_type->field (fieldno).name ();
525 int child_name_len = ada_name_prefix_len (field_name);
527 *child_path_expr =
528 string_printf ("(%s).%.*s", parent_path_expr,
529 child_name_len, field_name);
532 return;
535 childno++;
538 /* Something went wrong. Either we miscounted the number of
539 children, or CHILD_INDEX was too high. But we should never
540 reach here. We don't have enough information to recover
541 nicely, so just raise an assertion failure. */
542 gdb_assert_not_reached ("unexpected code path");
545 /* Same as ada_varobj_describe_child, but limited to pointer objects.
547 Note that CHILD_INDEX is unused in this situation, but still provided
548 for consistency of interface with other routines describing an object's
549 child. */
551 static void
552 ada_varobj_describe_ptr_child (struct value *parent_value,
553 struct type *parent_type,
554 const char *parent_name,
555 const char *parent_path_expr,
556 int child_index,
557 std::string *child_name,
558 struct value **child_value,
559 struct type **child_type,
560 std::string *child_path_expr)
562 if (child_name)
563 *child_name = string_printf ("%s.all", parent_name);
565 if (child_value && parent_value)
566 ada_varobj_ind (parent_value, parent_type, child_value, NULL);
568 if (child_type)
569 ada_varobj_ind (parent_value, parent_type, NULL, child_type);
571 if (child_path_expr)
572 *child_path_expr = string_printf ("(%s).all", parent_path_expr);
575 /* Same as ada_varobj_describe_child, limited to simple array objects
576 (TYPE_CODE_ARRAY only).
578 Assumes that the (PARENT_VALUE, PARENT_TYPE) pair is properly decoded.
579 This is done by ada_varobj_describe_child before calling us. */
581 static void
582 ada_varobj_describe_simple_array_child (struct value *parent_value,
583 struct type *parent_type,
584 const char *parent_name,
585 const char *parent_path_expr,
586 int child_index,
587 std::string *child_name,
588 struct value **child_value,
589 struct type **child_type,
590 std::string *child_path_expr)
592 struct type *index_type;
593 int real_index;
595 gdb_assert (parent_type->code () == TYPE_CODE_ARRAY);
597 index_type = parent_type->index_type ();
598 real_index = child_index + ada_discrete_type_low_bound (index_type);
600 if (child_name)
601 *child_name = ada_varobj_scalar_image (index_type, real_index);
603 if (child_value && parent_value)
604 ada_varobj_simple_array_elt (parent_value, parent_type, real_index,
605 child_value, NULL);
607 if (child_type)
608 ada_varobj_simple_array_elt (parent_value, parent_type, real_index,
609 NULL, child_type);
611 if (child_path_expr)
613 std::string index_img = ada_varobj_scalar_image (index_type, real_index);
615 /* Enumeration litterals by themselves are potentially ambiguous.
616 For instance, consider the following package spec:
618 package Pck is
619 type Color is (Red, Green, Blue, White);
620 type Blood_Cells is (White, Red);
621 end Pck;
623 In this case, the litteral "red" for instance, or even
624 the fully-qualified litteral "pck.red" cannot be resolved
625 by itself. Type qualification is needed to determine which
626 enumeration litterals should be used.
628 The following variable will be used to contain the name
629 of the array index type when such type qualification is
630 needed. */
631 const char *index_type_name = NULL;
632 std::string decoded;
634 /* If the index type is a range type, find the base type. */
635 while (index_type->code () == TYPE_CODE_RANGE)
636 index_type = index_type->target_type ();
638 if (index_type->code () == TYPE_CODE_ENUM
639 || index_type->code () == TYPE_CODE_BOOL)
641 index_type_name = ada_type_name (index_type);
642 if (index_type_name)
644 decoded = ada_decode (index_type_name);
645 index_type_name = decoded.c_str ();
649 if (index_type_name != NULL)
650 *child_path_expr =
651 string_printf ("(%s)(%.*s'(%s))", parent_path_expr,
652 ada_name_prefix_len (index_type_name),
653 index_type_name, index_img.c_str ());
654 else
655 *child_path_expr =
656 string_printf ("(%s)(%s)", parent_path_expr, index_img.c_str ());
660 /* See description at declaration above. */
662 static void
663 ada_varobj_describe_child (struct value *parent_value,
664 struct type *parent_type,
665 const char *parent_name,
666 const char *parent_path_expr,
667 int child_index,
668 std::string *child_name,
669 struct value **child_value,
670 struct type **child_type,
671 std::string *child_path_expr)
673 /* We cannot compute the child's path expression without
674 the parent's path expression. This is a pre-condition
675 for calling this function. */
676 if (child_path_expr)
677 gdb_assert (parent_path_expr != NULL);
679 ada_varobj_decode_var (&parent_value, &parent_type);
680 ada_varobj_adjust_for_child_access (&parent_value, &parent_type);
682 if (child_name)
683 *child_name = std::string ();
684 if (child_value)
685 *child_value = NULL;
686 if (child_type)
687 *child_type = NULL;
688 if (child_path_expr)
689 *child_path_expr = std::string ();
691 if (ada_is_access_to_unconstrained_array (parent_type))
693 ada_varobj_describe_ptr_child (parent_value, parent_type,
694 parent_name, parent_path_expr,
695 child_index, child_name,
696 child_value, child_type,
697 child_path_expr);
698 return;
701 if (parent_type->code () == TYPE_CODE_ARRAY)
703 ada_varobj_describe_simple_array_child
704 (parent_value, parent_type, parent_name, parent_path_expr,
705 child_index, child_name, child_value, child_type,
706 child_path_expr);
707 return;
710 if (parent_type->code () == TYPE_CODE_STRUCT
711 || parent_type->code () == TYPE_CODE_UNION)
713 ada_varobj_describe_struct_child (parent_value, parent_type,
714 parent_name, parent_path_expr,
715 child_index, child_name,
716 child_value, child_type,
717 child_path_expr);
718 return;
721 if (parent_type->code () == TYPE_CODE_PTR)
723 ada_varobj_describe_ptr_child (parent_value, parent_type,
724 parent_name, parent_path_expr,
725 child_index, child_name,
726 child_value, child_type,
727 child_path_expr);
728 return;
731 /* It should never happen. But rather than crash, report dummy names
732 and return a NULL child_value. */
733 if (child_name)
734 *child_name = "???";
737 /* Return the name of the child number CHILD_INDEX of the (PARENT_VALUE,
738 PARENT_TYPE) pair. PARENT_NAME is the name of the PARENT. */
740 static std::string
741 ada_varobj_get_name_of_child (struct value *parent_value,
742 struct type *parent_type,
743 const char *parent_name, int child_index)
745 std::string child_name;
747 ada_varobj_describe_child (parent_value, parent_type, parent_name,
748 NULL, child_index, &child_name, NULL,
749 NULL, NULL);
750 return child_name;
753 /* Return the path expression of the child number CHILD_INDEX of
754 the (PARENT_VALUE, PARENT_TYPE) pair. PARENT_NAME is the name
755 of the parent, and PARENT_PATH_EXPR is the parent's path expression.
756 Both must be non-NULL. */
758 static std::string
759 ada_varobj_get_path_expr_of_child (struct value *parent_value,
760 struct type *parent_type,
761 const char *parent_name,
762 const char *parent_path_expr,
763 int child_index)
765 std::string child_path_expr;
767 ada_varobj_describe_child (parent_value, parent_type, parent_name,
768 parent_path_expr, child_index, NULL,
769 NULL, NULL, &child_path_expr);
771 return child_path_expr;
774 /* Return the value of child number CHILD_INDEX of the (PARENT_VALUE,
775 PARENT_TYPE) pair. PARENT_NAME is the name of the parent. */
777 static struct value *
778 ada_varobj_get_value_of_child (struct value *parent_value,
779 struct type *parent_type,
780 const char *parent_name, int child_index)
782 struct value *child_value;
784 ada_varobj_describe_child (parent_value, parent_type, parent_name,
785 NULL, child_index, NULL, &child_value,
786 NULL, NULL);
788 return child_value;
791 /* Return the type of child number CHILD_INDEX of the (PARENT_VALUE,
792 PARENT_TYPE) pair. */
794 static struct type *
795 ada_varobj_get_type_of_child (struct value *parent_value,
796 struct type *parent_type,
797 int child_index)
799 struct type *child_type;
801 ada_varobj_describe_child (parent_value, parent_type, NULL, NULL,
802 child_index, NULL, NULL, &child_type, NULL);
804 return child_type;
807 /* Return a string that contains the image of the given VALUE, using
808 the print options OPTS as the options for formatting the result.
810 The resulting string must be deallocated after use with xfree. */
812 static std::string
813 ada_varobj_get_value_image (struct value *value,
814 struct value_print_options *opts)
816 string_file buffer;
818 common_val_print (value, &buffer, 0, opts, current_language);
819 return buffer.release ();
822 /* Assuming that the (VALUE, TYPE) pair designates an array varobj,
823 return a string that is suitable for use in the "value" field of
824 the varobj output. Most of the time, this is the number of elements
825 in the array inside square brackets, but there are situations where
826 it's useful to add more info.
828 OPTS are the print options used when formatting the result.
830 The result should be deallocated after use using xfree. */
832 static std::string
833 ada_varobj_get_value_of_array_variable (struct value *value,
834 struct type *type,
835 struct value_print_options *opts)
837 const int numchild = ada_varobj_get_array_number_of_children (value, type);
839 /* If we have a string, provide its contents in the "value" field.
840 Otherwise, the only other way to inspect the contents of the string
841 is by looking at the value of each element, as in any other array,
842 which is not very convenient... */
843 if (value
844 && ada_is_string_type (type)
845 && (opts->format == 0 || opts->format == 's'))
847 std::string str = ada_varobj_get_value_image (value, opts);
848 return string_printf ("[%d] %s", numchild, str.c_str ());
850 else
851 return string_printf ("[%d]", numchild);
854 /* Return a string representation of the (VALUE, TYPE) pair, using
855 the given print options OPTS as our formatting options. */
857 static std::string
858 ada_varobj_get_value_of_variable (struct value *value,
859 struct type *type,
860 struct value_print_options *opts)
862 ada_varobj_decode_var (&value, &type);
864 switch (type->code ())
866 case TYPE_CODE_STRUCT:
867 case TYPE_CODE_UNION:
868 return "{...}";
869 case TYPE_CODE_ARRAY:
870 return ada_varobj_get_value_of_array_variable (value, type, opts);
871 default:
872 if (!value)
873 return "";
874 else
875 return ada_varobj_get_value_image (value, opts);
879 /* Ada specific callbacks for VAROBJs. */
881 static int
882 ada_number_of_children (const struct varobj *var)
884 return ada_varobj_get_number_of_children (var->value.get (), var->type);
887 static std::string
888 ada_name_of_variable (const struct varobj *parent)
890 return c_varobj_ops.name_of_variable (parent);
893 static std::string
894 ada_name_of_child (const struct varobj *parent, int index)
896 return ada_varobj_get_name_of_child (parent->value.get (), parent->type,
897 parent->name.c_str (), index);
900 static std::string
901 ada_path_expr_of_child (const struct varobj *child)
903 const struct varobj *parent = child->parent;
904 const char *parent_path_expr = varobj_get_path_expr (parent);
906 return ada_varobj_get_path_expr_of_child (parent->value.get (),
907 parent->type,
908 parent->name.c_str (),
909 parent_path_expr,
910 child->index);
913 static struct value *
914 ada_value_of_child (const struct varobj *parent, int index)
916 return ada_varobj_get_value_of_child (parent->value.get (), parent->type,
917 parent->name.c_str (), index);
920 static struct type *
921 ada_type_of_child (const struct varobj *parent, int index)
923 return ada_varobj_get_type_of_child (parent->value.get (), parent->type,
924 index);
927 static std::string
928 ada_value_of_variable (const struct varobj *var,
929 enum varobj_display_formats format)
931 struct value_print_options opts;
933 varobj_formatted_print_options (&opts, format);
935 return ada_varobj_get_value_of_variable (var->value.get (), var->type,
936 &opts);
939 /* Implement the "value_is_changeable_p" routine for Ada. */
941 static bool
942 ada_value_is_changeable_p (const struct varobj *var)
944 struct type *type = (var->value != nullptr
945 ? var->value->type () : var->type);
947 if (type->code () == TYPE_CODE_REF)
948 type = type->target_type ();
950 if (ada_is_access_to_unconstrained_array (type))
952 /* This is in reality a pointer to an unconstrained array.
953 its value is changeable. */
954 return true;
957 if (ada_is_string_type (type))
959 /* We display the contents of the string in the array's
960 "value" field. The contents can change, so consider
961 that the array is changeable. */
962 return true;
965 return varobj_default_value_is_changeable_p (var);
968 /* Implement the "value_has_mutated" routine for Ada. */
970 static bool
971 ada_value_has_mutated (const struct varobj *var, struct value *new_val,
972 struct type *new_type)
974 int from = -1;
975 int to = -1;
977 /* If the number of fields have changed, then for sure the type
978 has mutated. */
979 if (ada_varobj_get_number_of_children (new_val, new_type)
980 != var->num_children)
981 return true;
983 /* If the number of fields have remained the same, then we need
984 to check the name of each field. If they remain the same,
985 then chances are the type hasn't mutated. This is technically
986 an incomplete test, as the child's type might have changed
987 despite the fact that the name remains the same. But we'll
988 handle this situation by saying that the child has mutated,
989 not this value.
991 If only part (or none!) of the children have been fetched,
992 then only check the ones we fetched. It does not matter
993 to the frontend whether a child that it has not fetched yet
994 has mutated or not. So just assume it hasn't. */
996 varobj_restrict_range (var->children, &from, &to);
997 for (int i = from; i < to; i++)
998 if (ada_varobj_get_name_of_child (new_val, new_type,
999 var->name.c_str (), i)
1000 != var->children[i]->name)
1001 return true;
1003 return false;
1006 /* varobj operations for ada. */
1008 const struct lang_varobj_ops ada_varobj_ops =
1010 ada_number_of_children,
1011 ada_name_of_variable,
1012 ada_name_of_child,
1013 ada_path_expr_of_child,
1014 ada_value_of_child,
1015 ada_type_of_child,
1016 ada_value_of_variable,
1017 ada_value_is_changeable_p,
1018 ada_value_has_mutated,
1019 varobj_default_is_path_expr_parent