xref: /netbsd-src/external/gpl3/gdb.old/dist/gdb/ada-varobj.c (revision 82d56013d7b633d116a93943de88e08335357a7c)
1 /* varobj support for Ada.
2 
3    Copyright (C) 2012-2019 Free Software Foundation, Inc.
4 
5    This file is part of GDB.
6 
7    This program is free software; you can redistribute it and/or modify
8    it under the terms of the GNU General Public License as published by
9    the Free Software Foundation; either version 3 of the License, or
10    (at your option) any later version.
11 
12    This program is distributed in the hope that it will be useful,
13    but WITHOUT ANY WARRANTY; without even the implied warranty of
14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15    GNU General Public License for more details.
16 
17    You should have received a copy of the GNU General Public License
18    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
19 
20 #include "defs.h"
21 #include "ada-lang.h"
22 #include "varobj.h"
23 #include "language.h"
24 #include "valprint.h"
25 
26 /* Implementation principle used in this unit:
27 
28    For our purposes, the meat of the varobj object is made of two
29    elements: The varobj's (struct) value, and the varobj's (struct)
30    type.  In most situations, the varobj has a non-NULL value, and
31    the type becomes redundant, as it can be directly derived from
32    the value.  In the initial implementation of this unit, most
33    routines would only take a value, and return a value.
34 
35    But there are many situations where it is possible for a varobj
36    to have a NULL value.  For instance, if the varobj becomes out of
37    scope.  Or better yet, when the varobj is the child of another
38    NULL pointer varobj.  In that situation, we must rely on the type
39    instead of the value to create the child varobj.
40 
41    That's why most functions below work with a (value, type) pair.
42    The value may or may not be NULL.  But the type is always expected
43    to be set.  When the value is NULL, then we work with the type
44    alone, and keep the value NULL.  But when the value is not NULL,
45    then we work using the value, because it provides more information.
46    But we still always set the type as well, even if that type could
47    easily be derived from the value.  The reason behind this is that
48    it allows the code to use the type without having to worry about
49    it being set or not.  It makes the code clearer.  */
50 
51 static int ada_varobj_get_number_of_children (struct value *parent_value,
52 					      struct type *parent_type);
53 
54 /* A convenience function that decodes the VALUE_PTR/TYPE_PTR couple:
55    If there is a value (*VALUE_PTR not NULL), then perform the decoding
56    using it, and compute the associated type from the resulting value.
57    Otherwise, compute a static approximation of *TYPE_PTR, leaving
58    *VALUE_PTR unchanged.
59 
60    The results are written in place.  */
61 
62 static void
63 ada_varobj_decode_var (struct value **value_ptr, struct type **type_ptr)
64 {
65   if (*value_ptr)
66     {
67       *value_ptr = ada_get_decoded_value (*value_ptr);
68       *type_ptr = ada_check_typedef (value_type (*value_ptr));
69     }
70   else
71     *type_ptr = ada_get_decoded_type (*type_ptr);
72 }
73 
74 /* Return a string containing an image of the given scalar value.
75    VAL is the numeric value, while TYPE is the value's type.
76    This is useful for plain integers, of course, but even more
77    so for enumerated types.  */
78 
79 static std::string
80 ada_varobj_scalar_image (struct type *type, LONGEST val)
81 {
82   string_file buf;
83 
84   ada_print_scalar (type, val, &buf);
85   return std::move (buf.string ());
86 }
87 
88 /* Assuming that the (PARENT_VALUE, PARENT_TYPE) pair designates
89    a struct or union, compute the (CHILD_VALUE, CHILD_TYPE) couple
90    corresponding to the field number FIELDNO.  */
91 
92 static void
93 ada_varobj_struct_elt (struct value *parent_value,
94 		       struct type *parent_type,
95 		       int fieldno,
96 		       struct value **child_value,
97 		       struct type **child_type)
98 {
99   struct value *value = NULL;
100   struct type *type = NULL;
101 
102   if (parent_value)
103     {
104       value = value_field (parent_value, fieldno);
105       type = value_type (value);
106     }
107   else
108     type = TYPE_FIELD_TYPE (parent_type, fieldno);
109 
110   if (child_value)
111     *child_value = value;
112   if (child_type)
113     *child_type = type;
114 }
115 
116 /* Assuming that the (PARENT_VALUE, PARENT_TYPE) pair is a pointer or
117    reference, return a (CHILD_VALUE, CHILD_TYPE) couple corresponding
118    to the dereferenced value.  */
119 
120 static void
121 ada_varobj_ind (struct value *parent_value,
122 		struct type *parent_type,
123 		struct value **child_value,
124 		struct type **child_type)
125 {
126   struct value *value = NULL;
127   struct type *type = NULL;
128 
129   if (ada_is_array_descriptor_type (parent_type))
130     {
131       /* This can only happen when PARENT_VALUE is NULL.  Otherwise,
132 	 ada_get_decoded_value would have transformed our parent_type
133 	 into a simple array pointer type.  */
134       gdb_assert (parent_value == NULL);
135       gdb_assert (TYPE_CODE (parent_type) == TYPE_CODE_TYPEDEF);
136 
137       /* Decode parent_type by the equivalent pointer to (decoded)
138 	 array.  */
139       while (TYPE_CODE (parent_type) == TYPE_CODE_TYPEDEF)
140 	parent_type = TYPE_TARGET_TYPE (parent_type);
141       parent_type = ada_coerce_to_simple_array_type (parent_type);
142       parent_type = lookup_pointer_type (parent_type);
143     }
144 
145   /* If parent_value is a null pointer, then only perform static
146      dereferencing.  We cannot dereference null pointers.  */
147   if (parent_value && value_as_address (parent_value) == 0)
148     parent_value = NULL;
149 
150   if (parent_value)
151     {
152       value = ada_value_ind (parent_value);
153       type = value_type (value);
154     }
155   else
156     type = TYPE_TARGET_TYPE (parent_type);
157 
158   if (child_value)
159     *child_value = value;
160   if (child_type)
161     *child_type = type;
162 }
163 
164 /* Assuming that the (PARENT_VALUE, PARENT_TYPE) pair is a simple
165    array (TYPE_CODE_ARRAY), return the (CHILD_VALUE, CHILD_TYPE)
166    pair corresponding to the element at ELT_INDEX.  */
167 
168 static void
169 ada_varobj_simple_array_elt (struct value *parent_value,
170 			     struct type *parent_type,
171 			     int elt_index,
172 			     struct value **child_value,
173 			     struct type **child_type)
174 {
175   struct value *value = NULL;
176   struct type *type = NULL;
177 
178   if (parent_value)
179     {
180       struct value *index_value =
181 	value_from_longest (TYPE_INDEX_TYPE (parent_type), elt_index);
182 
183       value = ada_value_subscript (parent_value, 1, &index_value);
184       type = value_type (value);
185     }
186   else
187     type = TYPE_TARGET_TYPE (parent_type);
188 
189   if (child_value)
190     *child_value = value;
191   if (child_type)
192     *child_type = type;
193 }
194 
195 /* Given the decoded value and decoded type of a variable object,
196    adjust the value and type to those necessary for getting children
197    of the variable object.
198 
199    The replacement is performed in place.  */
200 
201 static void
202 ada_varobj_adjust_for_child_access (struct value **value,
203 				    struct type **type)
204 {
205    /* Pointers to struct/union types are special: Instead of having
206       one child (the struct), their children are the components of
207       the struct/union type.  We handle this situation by dereferencing
208       the (value, type) couple.  */
209   if (TYPE_CODE (*type) == TYPE_CODE_PTR
210       && (TYPE_CODE (TYPE_TARGET_TYPE (*type)) == TYPE_CODE_STRUCT
211           || TYPE_CODE (TYPE_TARGET_TYPE (*type)) == TYPE_CODE_UNION)
212       && !ada_is_array_descriptor_type (TYPE_TARGET_TYPE (*type))
213       && !ada_is_constrained_packed_array_type (TYPE_TARGET_TYPE (*type)))
214     ada_varobj_ind (*value, *type, value, type);
215 
216   /* If this is a tagged type, we need to transform it a bit in order
217      to be able to fetch its full view.  As always with tagged types,
218      we can only do that if we have a value.  */
219   if (*value != NULL && ada_is_tagged_type (*type, 1))
220     {
221       *value = ada_tag_value_at_base_address (*value);
222       *type = value_type (*value);
223     }
224 }
225 
226 /* Assuming that the (PARENT_VALUE, PARENT_TYPE) pair is an array
227    (any type of array, "simple" or not), return the number of children
228    that this array contains.  */
229 
230 static int
231 ada_varobj_get_array_number_of_children (struct value *parent_value,
232 					 struct type *parent_type)
233 {
234   LONGEST lo, hi;
235 
236   if (parent_value == NULL
237       && is_dynamic_type (TYPE_INDEX_TYPE (parent_type)))
238     {
239       /* This happens when listing the children of an object
240 	 which does not exist in memory (Eg: when requesting
241 	 the children of a null pointer, which is allowed by
242 	 varobj).  The array index type being dynamic, we cannot
243 	 determine how many elements this array has.  Just assume
244 	 it has none.  */
245       return 0;
246     }
247 
248   if (!get_array_bounds (parent_type, &lo, &hi))
249     {
250       /* Could not get the array bounds.  Pretend this is an empty array.  */
251       warning (_("unable to get bounds of array, assuming null array"));
252       return 0;
253     }
254 
255   /* Ada allows the upper bound to be less than the lower bound,
256      in order to specify empty arrays...  */
257   if (hi < lo)
258     return 0;
259 
260   return hi - lo + 1;
261 }
262 
263 /* Assuming that the (PARENT_VALUE, PARENT_TYPE) pair is a struct or
264    union, return the number of children this struct contains.  */
265 
266 static int
267 ada_varobj_get_struct_number_of_children (struct value *parent_value,
268 					  struct type *parent_type)
269 {
270   int n_children = 0;
271   int i;
272 
273   gdb_assert (TYPE_CODE (parent_type) == TYPE_CODE_STRUCT
274 	      || TYPE_CODE (parent_type) == TYPE_CODE_UNION);
275 
276   for (i = 0; i < TYPE_NFIELDS (parent_type); i++)
277     {
278       if (ada_is_ignored_field (parent_type, i))
279 	continue;
280 
281       if (ada_is_wrapper_field (parent_type, i))
282 	{
283 	  struct value *elt_value;
284 	  struct type *elt_type;
285 
286 	  ada_varobj_struct_elt (parent_value, parent_type, i,
287 				 &elt_value, &elt_type);
288 	  if (ada_is_tagged_type (elt_type, 0))
289 	    {
290 	      /* We must not use ada_varobj_get_number_of_children
291 		 to determine is element's number of children, because
292 		 this function first calls ada_varobj_decode_var,
293 		 which "fixes" the element.  For tagged types, this
294 		 includes reading the object's tag to determine its
295 		 real type, which happens to be the parent_type, and
296 		 leads to an infinite loop (because the element gets
297 		 fixed back into the parent).  */
298 	      n_children += ada_varobj_get_struct_number_of_children
299 		(elt_value, elt_type);
300 	    }
301 	  else
302 	    n_children += ada_varobj_get_number_of_children (elt_value, elt_type);
303 	}
304       else if (ada_is_variant_part (parent_type, i))
305 	{
306 	  /* In normal situations, the variant part of the record should
307 	     have been "fixed". Or, in other words, it should have been
308 	     replaced by the branch of the variant part that is relevant
309 	     for our value.  But there are still situations where this
310 	     can happen, however (Eg. when our parent is a NULL pointer).
311 	     We do not support showing this part of the record for now,
312 	     so just pretend this field does not exist.  */
313 	}
314       else
315 	n_children++;
316     }
317 
318   return n_children;
319 }
320 
321 /* Assuming that the (PARENT_VALUE, PARENT_TYPE) pair designates
322    a pointer, return the number of children this pointer has.  */
323 
324 static int
325 ada_varobj_get_ptr_number_of_children (struct value *parent_value,
326 				       struct type *parent_type)
327 {
328   struct type *child_type = TYPE_TARGET_TYPE (parent_type);
329 
330   /* Pointer to functions and to void do not have a child, since
331      you cannot print what they point to.  */
332   if (TYPE_CODE (child_type) == TYPE_CODE_FUNC
333       || TYPE_CODE (child_type) == TYPE_CODE_VOID)
334     return 0;
335 
336   /* All other types have 1 child.  */
337   return 1;
338 }
339 
340 /* Return the number of children for the (PARENT_VALUE, PARENT_TYPE)
341    pair.  */
342 
343 static int
344 ada_varobj_get_number_of_children (struct value *parent_value,
345 				   struct type *parent_type)
346 {
347   ada_varobj_decode_var (&parent_value, &parent_type);
348   ada_varobj_adjust_for_child_access (&parent_value, &parent_type);
349 
350   /* A typedef to an array descriptor in fact represents a pointer
351      to an unconstrained array.  These types always have one child
352      (the unconstrained array).  */
353   if (ada_is_access_to_unconstrained_array (parent_type))
354     return 1;
355 
356   if (TYPE_CODE (parent_type) == TYPE_CODE_ARRAY)
357     return ada_varobj_get_array_number_of_children (parent_value,
358 						    parent_type);
359 
360   if (TYPE_CODE (parent_type) == TYPE_CODE_STRUCT
361       || TYPE_CODE (parent_type) == TYPE_CODE_UNION)
362     return ada_varobj_get_struct_number_of_children (parent_value,
363 						     parent_type);
364 
365   if (TYPE_CODE (parent_type) == TYPE_CODE_PTR)
366     return ada_varobj_get_ptr_number_of_children (parent_value,
367 						  parent_type);
368 
369   /* All other types have no child.  */
370   return 0;
371 }
372 
373 /* Describe the child of the (PARENT_VALUE, PARENT_TYPE) pair
374    whose index is CHILD_INDEX:
375 
376      - If CHILD_NAME is not NULL, then a copy of the child's name
377        is saved in *CHILD_NAME.  This copy must be deallocated
378        with xfree after use.
379 
380      - If CHILD_VALUE is not NULL, then save the child's value
381        in *CHILD_VALUE. Same thing for the child's type with
382        CHILD_TYPE if not NULL.
383 
384      - If CHILD_PATH_EXPR is not NULL, then compute the child's
385        path expression.  The resulting string must be deallocated
386        after use with xfree.
387 
388        Computing the child's path expression requires the PARENT_PATH_EXPR
389        to be non-NULL.  Otherwise, PARENT_PATH_EXPR may be null if
390        CHILD_PATH_EXPR is NULL.
391 
392   PARENT_NAME is the name of the parent, and should never be NULL.  */
393 
394 static void ada_varobj_describe_child (struct value *parent_value,
395 				       struct type *parent_type,
396 				       const char *parent_name,
397 				       const char *parent_path_expr,
398 				       int child_index,
399 				       std::string *child_name,
400 				       struct value **child_value,
401 				       struct type **child_type,
402 				       std::string *child_path_expr);
403 
404 /* Same as ada_varobj_describe_child, but limited to struct/union
405    objects.  */
406 
407 static void
408 ada_varobj_describe_struct_child (struct value *parent_value,
409 				  struct type *parent_type,
410 				  const char *parent_name,
411 				  const char *parent_path_expr,
412 				  int child_index,
413 				  std::string *child_name,
414 				  struct value **child_value,
415 				  struct type **child_type,
416 				  std::string *child_path_expr)
417 {
418   int fieldno;
419   int childno = 0;
420 
421   gdb_assert (TYPE_CODE (parent_type) == TYPE_CODE_STRUCT
422 	      || TYPE_CODE (parent_type) == TYPE_CODE_UNION);
423 
424   for (fieldno = 0; fieldno < TYPE_NFIELDS (parent_type); fieldno++)
425     {
426       if (ada_is_ignored_field (parent_type, fieldno))
427 	continue;
428 
429       if (ada_is_wrapper_field (parent_type, fieldno))
430 	{
431 	  struct value *elt_value;
432 	  struct type *elt_type;
433 	  int elt_n_children;
434 
435 	  ada_varobj_struct_elt (parent_value, parent_type, fieldno,
436 				 &elt_value, &elt_type);
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_get_number_of_children, to prevent our
442 		 element from being fixed back into the parent.  */
443 	      elt_n_children = ada_varobj_get_struct_number_of_children
444 		(elt_value, elt_type);
445 	    }
446 	  else
447 	    elt_n_children =
448 	      ada_varobj_get_number_of_children (elt_value, elt_type);
449 
450 	  /* Is the child we're looking for one of the children
451 	     of this wrapper field?  */
452 	  if (child_index - childno < elt_n_children)
453 	    {
454 	      if (ada_is_tagged_type (elt_type, 0))
455 		{
456 		  /* Same as in ada_varobj_get_struct_number_of_children:
457 		     For tagged types, we must be careful to not call
458 		     ada_varobj_describe_child, to prevent our element
459 		     from being fixed back into the parent.  */
460 		  ada_varobj_describe_struct_child
461 		    (elt_value, elt_type, parent_name, parent_path_expr,
462 		     child_index - childno, child_name, child_value,
463 		     child_type, child_path_expr);
464 		}
465 	      else
466 		ada_varobj_describe_child (elt_value, elt_type,
467 					   parent_name, parent_path_expr,
468 					   child_index - childno,
469 					   child_name, child_value,
470 					   child_type, child_path_expr);
471 	      return;
472 	    }
473 
474 	  /* The child we're looking for is beyond this wrapper
475 	     field, so skip all its children.  */
476 	  childno += elt_n_children;
477 	  continue;
478 	}
479       else if (ada_is_variant_part (parent_type, fieldno))
480 	{
481 	  /* In normal situations, the variant part of the record should
482 	     have been "fixed". Or, in other words, it should have been
483 	     replaced by the branch of the variant part that is relevant
484 	     for our value.  But there are still situations where this
485 	     can happen, however (Eg. when our parent is a NULL pointer).
486 	     We do not support showing this part of the record for now,
487 	     so just pretend this field does not exist.  */
488 	  continue;
489 	}
490 
491       if (childno == child_index)
492 	{
493 	  if (child_name)
494 	    {
495 	      /* The name of the child is none other than the field's
496 		 name, except that we need to strip suffixes from it.
497 		 For instance, fields with alignment constraints will
498 		 have an __XVA suffix added to them.  */
499 	      const char *field_name = TYPE_FIELD_NAME (parent_type, fieldno);
500 	      int child_name_len = ada_name_prefix_len (field_name);
501 
502 	      *child_name = string_printf ("%.*s", child_name_len, field_name);
503 	    }
504 
505 	  if (child_value && parent_value)
506 	    ada_varobj_struct_elt (parent_value, parent_type, fieldno,
507 				   child_value, NULL);
508 
509 	  if (child_type)
510 	    ada_varobj_struct_elt (parent_value, parent_type, fieldno,
511 				   NULL, child_type);
512 
513 	  if (child_path_expr)
514 	    {
515 	      /* The name of the child is none other than the field's
516 		 name, except that we need to strip suffixes from it.
517 		 For instance, fields with alignment constraints will
518 		 have an __XVA suffix added to them.  */
519 	      const char *field_name = TYPE_FIELD_NAME (parent_type, fieldno);
520 	      int child_name_len = ada_name_prefix_len (field_name);
521 
522 	      *child_path_expr =
523 		string_printf ("(%s).%.*s", parent_path_expr,
524 			       child_name_len, field_name);
525 	    }
526 
527 	  return;
528 	}
529 
530       childno++;
531     }
532 
533   /* Something went wrong.  Either we miscounted the number of
534      children, or CHILD_INDEX was too high.  But we should never
535      reach here.  We don't have enough information to recover
536      nicely, so just raise an assertion failure.  */
537   gdb_assert_not_reached ("unexpected code path");
538 }
539 
540 /* Same as ada_varobj_describe_child, but limited to pointer objects.
541 
542    Note that CHILD_INDEX is unused in this situation, but still provided
543    for consistency of interface with other routines describing an object's
544    child.  */
545 
546 static void
547 ada_varobj_describe_ptr_child (struct value *parent_value,
548 			       struct type *parent_type,
549 			       const char *parent_name,
550 			       const char *parent_path_expr,
551 			       int child_index,
552 			       std::string *child_name,
553 			       struct value **child_value,
554 			       struct type **child_type,
555 			       std::string *child_path_expr)
556 {
557   if (child_name)
558     *child_name = string_printf ("%s.all", parent_name);
559 
560   if (child_value && parent_value)
561     ada_varobj_ind (parent_value, parent_type, child_value, NULL);
562 
563   if (child_type)
564     ada_varobj_ind (parent_value, parent_type, NULL, child_type);
565 
566   if (child_path_expr)
567     *child_path_expr = string_printf ("(%s).all", parent_path_expr);
568 }
569 
570 /* Same as ada_varobj_describe_child, limited to simple array objects
571    (TYPE_CODE_ARRAY only).
572 
573    Assumes that the (PARENT_VALUE, PARENT_TYPE) pair is properly decoded.
574    This is done by ada_varobj_describe_child before calling us.  */
575 
576 static void
577 ada_varobj_describe_simple_array_child (struct value *parent_value,
578 					struct type *parent_type,
579 					const char *parent_name,
580 					const char *parent_path_expr,
581 					int child_index,
582 					std::string *child_name,
583 					struct value **child_value,
584 					struct type **child_type,
585 					std::string *child_path_expr)
586 {
587   struct type *index_type;
588   int real_index;
589 
590   gdb_assert (TYPE_CODE (parent_type) == TYPE_CODE_ARRAY);
591 
592   index_type = TYPE_INDEX_TYPE (parent_type);
593   real_index = child_index + ada_discrete_type_low_bound (index_type);
594 
595   if (child_name)
596     *child_name = ada_varobj_scalar_image (index_type, real_index);
597 
598   if (child_value && parent_value)
599     ada_varobj_simple_array_elt (parent_value, parent_type, real_index,
600 				 child_value, NULL);
601 
602   if (child_type)
603     ada_varobj_simple_array_elt (parent_value, parent_type, real_index,
604 				 NULL, child_type);
605 
606   if (child_path_expr)
607     {
608       std::string index_img = ada_varobj_scalar_image (index_type, real_index);
609 
610       /* Enumeration litterals by themselves are potentially ambiguous.
611 	 For instance, consider the following package spec:
612 
613 	    package Pck is
614 	       type Color is (Red, Green, Blue, White);
615 	       type Blood_Cells is (White, Red);
616 	    end Pck;
617 
618 	 In this case, the litteral "red" for instance, or even
619 	 the fully-qualified litteral "pck.red" cannot be resolved
620 	 by itself.  Type qualification is needed to determine which
621 	 enumeration litterals should be used.
622 
623 	 The following variable will be used to contain the name
624 	 of the array index type when such type qualification is
625 	 needed.  */
626       const char *index_type_name = NULL;
627 
628       /* If the index type is a range type, find the base type.  */
629       while (TYPE_CODE (index_type) == TYPE_CODE_RANGE)
630 	index_type = TYPE_TARGET_TYPE (index_type);
631 
632       if (TYPE_CODE (index_type) == TYPE_CODE_ENUM
633 	  || TYPE_CODE (index_type) == TYPE_CODE_BOOL)
634 	{
635 	  index_type_name = ada_type_name (index_type);
636 	  if (index_type_name)
637 	    index_type_name = ada_decode (index_type_name);
638 	}
639 
640       if (index_type_name != NULL)
641 	*child_path_expr =
642 	  string_printf ("(%s)(%.*s'(%s))", parent_path_expr,
643 			 ada_name_prefix_len (index_type_name),
644 			 index_type_name, index_img.c_str ());
645       else
646 	*child_path_expr =
647 	  string_printf ("(%s)(%s)", parent_path_expr, index_img.c_str ());
648     }
649 }
650 
651 /* See description at declaration above.  */
652 
653 static void
654 ada_varobj_describe_child (struct value *parent_value,
655 			   struct type *parent_type,
656 			   const char *parent_name,
657 			   const char *parent_path_expr,
658 			   int child_index,
659 			   std::string *child_name,
660 			   struct value **child_value,
661 			   struct type **child_type,
662 			   std::string *child_path_expr)
663 {
664   /* We cannot compute the child's path expression without
665      the parent's path expression.  This is a pre-condition
666      for calling this function.  */
667   if (child_path_expr)
668     gdb_assert (parent_path_expr != NULL);
669 
670   ada_varobj_decode_var (&parent_value, &parent_type);
671   ada_varobj_adjust_for_child_access (&parent_value, &parent_type);
672 
673   if (child_name)
674     *child_name = std::string ();
675   if (child_value)
676     *child_value = NULL;
677   if (child_type)
678     *child_type = NULL;
679   if (child_path_expr)
680     *child_path_expr = std::string ();
681 
682   if (ada_is_access_to_unconstrained_array (parent_type))
683     {
684       ada_varobj_describe_ptr_child (parent_value, parent_type,
685 				     parent_name, parent_path_expr,
686 				     child_index, child_name,
687 				     child_value, child_type,
688 				     child_path_expr);
689       return;
690     }
691 
692   if (TYPE_CODE (parent_type) == TYPE_CODE_ARRAY)
693     {
694       ada_varobj_describe_simple_array_child
695 	(parent_value, parent_type, parent_name, parent_path_expr,
696 	 child_index, child_name, child_value, child_type,
697 	 child_path_expr);
698       return;
699     }
700 
701   if (TYPE_CODE (parent_type) == TYPE_CODE_STRUCT
702       || TYPE_CODE (parent_type) == TYPE_CODE_UNION)
703     {
704       ada_varobj_describe_struct_child (parent_value, parent_type,
705 					parent_name, parent_path_expr,
706 					child_index, child_name,
707 					child_value, child_type,
708 					child_path_expr);
709       return;
710     }
711 
712   if (TYPE_CODE (parent_type) == TYPE_CODE_PTR)
713     {
714       ada_varobj_describe_ptr_child (parent_value, parent_type,
715 				     parent_name, parent_path_expr,
716 				     child_index, child_name,
717 				     child_value, child_type,
718 				     child_path_expr);
719       return;
720     }
721 
722   /* It should never happen.  But rather than crash, report dummy names
723      and return a NULL child_value.  */
724   if (child_name)
725     *child_name = "???";
726 }
727 
728 /* Return the name of the child number CHILD_INDEX of the (PARENT_VALUE,
729    PARENT_TYPE) pair.  PARENT_NAME is the name of the PARENT.  */
730 
731 static std::string
732 ada_varobj_get_name_of_child (struct value *parent_value,
733 			      struct type *parent_type,
734 			      const char *parent_name, int child_index)
735 {
736   std::string child_name;
737 
738   ada_varobj_describe_child (parent_value, parent_type, parent_name,
739 			     NULL, child_index, &child_name, NULL,
740 			     NULL, NULL);
741   return child_name;
742 }
743 
744 /* Return the path expression of the child number CHILD_INDEX of
745    the (PARENT_VALUE, PARENT_TYPE) pair.  PARENT_NAME is the name
746    of the parent, and PARENT_PATH_EXPR is the parent's path expression.
747    Both must be non-NULL.  */
748 
749 static std::string
750 ada_varobj_get_path_expr_of_child (struct value *parent_value,
751 				   struct type *parent_type,
752 				   const char *parent_name,
753 				   const char *parent_path_expr,
754 				   int child_index)
755 {
756   std::string child_path_expr;
757 
758   ada_varobj_describe_child (parent_value, parent_type, parent_name,
759 			     parent_path_expr, child_index, NULL,
760 			     NULL, NULL, &child_path_expr);
761 
762   return child_path_expr;
763 }
764 
765 /* Return the value of child number CHILD_INDEX of the (PARENT_VALUE,
766    PARENT_TYPE) pair.  PARENT_NAME is the name of the parent.  */
767 
768 static struct value *
769 ada_varobj_get_value_of_child (struct value *parent_value,
770 			       struct type *parent_type,
771 			       const char *parent_name, int child_index)
772 {
773   struct value *child_value;
774 
775   ada_varobj_describe_child (parent_value, parent_type, parent_name,
776 			     NULL, child_index, NULL, &child_value,
777 			     NULL, NULL);
778 
779   return child_value;
780 }
781 
782 /* Return the type of child number CHILD_INDEX of the (PARENT_VALUE,
783    PARENT_TYPE) pair.  */
784 
785 static struct type *
786 ada_varobj_get_type_of_child (struct value *parent_value,
787 			      struct type *parent_type,
788 			      int child_index)
789 {
790   struct type *child_type;
791 
792   ada_varobj_describe_child (parent_value, parent_type, NULL, NULL,
793 			     child_index, NULL, NULL, &child_type, NULL);
794 
795   return child_type;
796 }
797 
798 /* Return a string that contains the image of the given VALUE, using
799    the print options OPTS as the options for formatting the result.
800 
801    The resulting string must be deallocated after use with xfree.  */
802 
803 static std::string
804 ada_varobj_get_value_image (struct value *value,
805 			    struct value_print_options *opts)
806 {
807   string_file buffer;
808 
809   common_val_print (value, &buffer, 0, opts, current_language);
810   return std::move (buffer.string ());
811 }
812 
813 /* Assuming that the (VALUE, TYPE) pair designates an array varobj,
814    return a string that is suitable for use in the "value" field of
815    the varobj output.  Most of the time, this is the number of elements
816    in the array inside square brackets, but there are situations where
817    it's useful to add more info.
818 
819    OPTS are the print options used when formatting the result.
820 
821    The result should be deallocated after use using xfree.  */
822 
823 static std::string
824 ada_varobj_get_value_of_array_variable (struct value *value,
825 					struct type *type,
826 					struct value_print_options *opts)
827 {
828   const int numchild = ada_varobj_get_array_number_of_children (value, type);
829 
830   /* If we have a string, provide its contents in the "value" field.
831      Otherwise, the only other way to inspect the contents of the string
832      is by looking at the value of each element, as in any other array,
833      which is not very convenient...  */
834   if (value
835       && ada_is_string_type (type)
836       && (opts->format == 0 || opts->format == 's'))
837     {
838       std::string str = ada_varobj_get_value_image (value, opts);
839       return string_printf ("[%d] %s", numchild, str.c_str ());
840     }
841   else
842     return string_printf ("[%d]", numchild);
843 }
844 
845 /* Return a string representation of the (VALUE, TYPE) pair, using
846    the given print options OPTS as our formatting options.  */
847 
848 static std::string
849 ada_varobj_get_value_of_variable (struct value *value,
850 				  struct type *type,
851 				  struct value_print_options *opts)
852 {
853   ada_varobj_decode_var (&value, &type);
854 
855   switch (TYPE_CODE (type))
856     {
857     case TYPE_CODE_STRUCT:
858     case TYPE_CODE_UNION:
859       return "{...}";
860     case TYPE_CODE_ARRAY:
861       return ada_varobj_get_value_of_array_variable (value, type, opts);
862     default:
863       if (!value)
864 	return "";
865       else
866 	return ada_varobj_get_value_image (value, opts);
867     }
868 }
869 
870 /* Ada specific callbacks for VAROBJs.  */
871 
872 static int
873 ada_number_of_children (const struct varobj *var)
874 {
875   return ada_varobj_get_number_of_children (var->value.get (), var->type);
876 }
877 
878 static std::string
879 ada_name_of_variable (const struct varobj *parent)
880 {
881   return c_varobj_ops.name_of_variable (parent);
882 }
883 
884 static std::string
885 ada_name_of_child (const struct varobj *parent, int index)
886 {
887   return ada_varobj_get_name_of_child (parent->value.get (), parent->type,
888 				       parent->name.c_str (), index);
889 }
890 
891 static std::string
892 ada_path_expr_of_child (const struct varobj *child)
893 {
894   const struct varobj *parent = child->parent;
895   const char *parent_path_expr = varobj_get_path_expr (parent);
896 
897   return ada_varobj_get_path_expr_of_child (parent->value.get (),
898 					    parent->type,
899 					    parent->name.c_str (),
900 					    parent_path_expr,
901 					    child->index);
902 }
903 
904 static struct value *
905 ada_value_of_child (const struct varobj *parent, int index)
906 {
907   return ada_varobj_get_value_of_child (parent->value.get (), parent->type,
908 					parent->name.c_str (), index);
909 }
910 
911 static struct type *
912 ada_type_of_child (const struct varobj *parent, int index)
913 {
914   return ada_varobj_get_type_of_child (parent->value.get (), parent->type,
915 				       index);
916 }
917 
918 static std::string
919 ada_value_of_variable (const struct varobj *var,
920 		       enum varobj_display_formats format)
921 {
922   struct value_print_options opts;
923 
924   varobj_formatted_print_options (&opts, format);
925 
926   return ada_varobj_get_value_of_variable (var->value.get (), var->type,
927 					   &opts);
928 }
929 
930 /* Implement the "value_is_changeable_p" routine for Ada.  */
931 
932 static bool
933 ada_value_is_changeable_p (const struct varobj *var)
934 {
935   struct type *type = (var->value != nullptr
936 		       ? value_type (var->value.get ()) : var->type);
937 
938   if (TYPE_CODE (type) == TYPE_CODE_REF)
939     type = TYPE_TARGET_TYPE (type);
940 
941   if (ada_is_access_to_unconstrained_array (type))
942     {
943       /* This is in reality a pointer to an unconstrained array.
944 	 its value is changeable.  */
945       return true;
946     }
947 
948   if (ada_is_string_type (type))
949     {
950       /* We display the contents of the string in the array's
951 	 "value" field.  The contents can change, so consider
952 	 that the array is changeable.  */
953       return true;
954     }
955 
956   return varobj_default_value_is_changeable_p (var);
957 }
958 
959 /* Implement the "value_has_mutated" routine for Ada.  */
960 
961 static bool
962 ada_value_has_mutated (const struct varobj *var, struct value *new_val,
963 		       struct type *new_type)
964 {
965   int from = -1;
966   int to = -1;
967 
968   /* If the number of fields have changed, then for sure the type
969      has mutated.  */
970   if (ada_varobj_get_number_of_children (new_val, new_type)
971       != var->num_children)
972     return true;
973 
974   /* If the number of fields have remained the same, then we need
975      to check the name of each field.  If they remain the same,
976      then chances are the type hasn't mutated.  This is technically
977      an incomplete test, as the child's type might have changed
978      despite the fact that the name remains the same.  But we'll
979      handle this situation by saying that the child has mutated,
980      not this value.
981 
982      If only part (or none!) of the children have been fetched,
983      then only check the ones we fetched.  It does not matter
984      to the frontend whether a child that it has not fetched yet
985      has mutated or not. So just assume it hasn't.  */
986 
987   varobj_restrict_range (var->children, &from, &to);
988   for (int i = from; i < to; i++)
989     if (ada_varobj_get_name_of_child (new_val, new_type,
990 				      var->name.c_str (), i)
991 	!= var->children[i]->name)
992       return true;
993 
994   return false;
995 }
996 
997 /* varobj operations for ada.  */
998 
999 const struct lang_varobj_ops ada_varobj_ops =
1000 {
1001   ada_number_of_children,
1002   ada_name_of_variable,
1003   ada_name_of_child,
1004   ada_path_expr_of_child,
1005   ada_value_of_child,
1006   ada_type_of_child,
1007   ada_value_of_variable,
1008   ada_value_is_changeable_p,
1009   ada_value_has_mutated,
1010   varobj_default_is_path_expr_parent
1011 };
1012