From: Joel Brobecker <brobecker@gnat.com>
Date: Wed, 10 Sep 2008 20:14:30 +0000 (+0000)
Subject:         * ada-lang.c (ada_parent_type): Add handling of the case where
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=0c1f74cf556520cf287f556c0f59a33dac4a84d1;p=binutils-gdb.git

    * ada-lang.c (ada_parent_type): Add handling of the case where
        the _parent field is a pointer and/or has a parallel XVS type.
        (ada_evaluate_subexp) [OP_VAR_VALUE]: When doing an
        EVAL_AVOID_SIDE_EFFECTS evaluation of a tagged type, return
        the type of the tag instead of doing forcing an EVAL_NORMAL
        expression evaluation.
---

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 0bcbd5b7fb8..178b5478c12 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,12 @@
+2008-09-10  Joel Brobecker  <brobecker@adacore.com>
+
+	* ada-lang.c (ada_parent_type): Add handling of the case where
+	the _parent field is a pointer and/or has a parallel XVS type.
+	(ada_evaluate_subexp) [OP_VAR_VALUE]: When doing an
+	EVAL_AVOID_SIDE_EFFECTS evaluation of a tagged type, return
+	the type of the tag instead of doing forcing an EVAL_NORMAL
+	expression evaluation.
+
 2008-09-10  Paul N. Hilfinger  <hilfinger@adacore.com> 
 	    Joel Brobecker  <brobecker@adacore.com>
 
diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index d6da0f49a09..50fd5eb739a 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -5769,7 +5769,17 @@ ada_parent_type (struct type *type)
 
   for (i = 0; i < TYPE_NFIELDS (type); i += 1)
     if (ada_is_parent_field (type, i))
-      return ada_check_typedef (TYPE_FIELD_TYPE (type, i));
+      {
+        struct type *parent_type = TYPE_FIELD_TYPE (type, i);
+
+        /* If the _parent field is a pointer, then dereference it.  */
+        if (TYPE_CODE (parent_type) == TYPE_CODE_PTR)
+          parent_type = TYPE_TARGET_TYPE (parent_type);
+        /* If there is a parallel XVS type, get the actual base type.  */
+        parent_type = ada_get_base_type (parent_type);
+
+        return ada_check_typedef (parent_type);
+      }
 
   return NULL;
 }
@@ -8553,14 +8563,6 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
     case OP_VAR_VALUE:
       *pos -= 1;
 
-      /* Tagged types are a little special in the fact that the real type
-         is dynamic and can only be determined by inspecting the object
-         value.  So even if we're support to do an EVAL_AVOID_SIDE_EFFECTS
-         evaluation, we force an EVAL_NORMAL evaluation for tagged types.  */
-      if (noside == EVAL_AVOID_SIDE_EFFECTS
-          && ada_is_tagged_type (SYMBOL_TYPE (exp->elts[pc + 2].symbol), 1))
-        noside = EVAL_NORMAL;
-
       if (noside == EVAL_SKIP)
         {
           *pos += 4;
@@ -8574,6 +8576,30 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
                SYMBOL_PRINT_NAME (exp->elts[pc + 2].symbol));
       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
         {
+          type = static_unwrap_type (SYMBOL_TYPE (exp->elts[pc + 2].symbol));
+          if (ada_is_tagged_type (type, 0))
+          {
+            /* Tagged types are a little special in the fact that the real
+               type is dynamic and can only be determined by inspecting the
+               object's tag.  This means that we need to get the object's
+               value first (EVAL_NORMAL) and then extract the actual object
+               type from its tag.
+
+               Note that we cannot skip the final step where we extract
+               the object type from its tag, because the EVAL_NORMAL phase
+               results in dynamic components being resolved into fixed ones.
+               This can cause problems when trying to print the type
+               description of tagged types whose parent has a dynamic size:
+               We use the type name of the "_parent" component in order
+               to print the name of the ancestor type in the type description.
+               If that component had a dynamic size, the resolution into
+               a fixed type would result in the loss of that type name,
+               thus preventing us from printing the name of the ancestor
+               type in the type description.  */
+            arg1 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_NORMAL);
+            return value_zero (type_from_tag (ada_value_tag (arg1)), not_lval);
+          }
+
           *pos += 4;
           return value_zero
             (to_static_fixed_type