Replace some symbol accessor macros with functions.
[deliverable/binutils-gdb.git] / gdb / ada-lang.c
index da304abfd2dd740c3289630cc7ea202ea9ab5fba..f453ef02d47b2f1e2a99644876bc1c271d48658a 100644 (file)
 
 
 #include "defs.h"
-#include <stdio.h>
-#include <string.h>
 #include <ctype.h>
-#include <stdarg.h>
 #include "demangle.h"
 #include "gdb_regex.h"
 #include "frame.h"
@@ -48,7 +45,6 @@
 #include "block.h"
 #include "infcall.h"
 #include "dictionary.h"
-#include "exceptions.h"
 #include "annotate.h"
 #include "valprint.h"
 #include "source.h"
@@ -236,8 +232,6 @@ static int ada_is_direct_array_type (struct type *);
 static void ada_language_arch_info (struct gdbarch *,
                                    struct language_arch_info *);
 
-static void check_size (const struct type *);
-
 static struct value *ada_index_struct_field (int, struct value *, int,
                                             struct type *);
 
@@ -357,7 +351,8 @@ static struct cmd_list_element *maint_show_ada_cmdlist;
 static void
 maint_set_ada_cmd (char *args, int from_tty)
 {
-  help_list (maint_set_ada_cmdlist, "maintenance set ada ", -1, gdb_stdout);
+  help_list (maint_set_ada_cmdlist, "maintenance set ada ", all_commands,
+            gdb_stdout);
 }
 
 /* Implement the "maintenance show ada" (prefix) command.  */
@@ -526,8 +521,16 @@ ada_typedef_target_type (struct type *type)
 static const char *
 ada_unqualified_name (const char *decoded_name)
 {
-  const char *result = strrchr (decoded_name, '.');
+  const char *result;
+  
+  /* If the decoded name starts with '<', it means that the encoded
+     name does not follow standard naming conventions, and thus that
+     it is not your typical Ada symbol name.  Trying to unqualify it
+     is therefore pointless and possibly erroneous.  */
+  if (decoded_name[0] == '<')
+    return decoded_name;
 
+  result = strrchr (decoded_name, '.');
   if (result != NULL)
     result++;                   /* Skip the dot...  */
   else
@@ -673,7 +676,7 @@ coerce_unspec_val_to_type (struct value *val, struct type *type)
 
       /* Make sure that the object size is not unreasonable before
          trying to allocate some memory for it.  */
-      check_size (type);
+      ada_ensure_varsize_limit (type);
 
       if (value_lazy (val)
           || TYPE_LENGTH (type) > TYPE_LENGTH (value_type (val)))
@@ -681,14 +684,12 @@ coerce_unspec_val_to_type (struct value *val, struct type *type)
       else
        {
          result = allocate_value (type);
-         memcpy (value_contents_raw (result), value_contents (val),
-                 TYPE_LENGTH (type));
+         value_contents_copy_raw (result, 0, val, 0, TYPE_LENGTH (type));
        }
       set_value_component_location (result, val);
       set_value_bitsize (result, value_bitsize (val));
       set_value_bitpos (result, value_bitpos (val));
       set_value_address (result, value_address (val));
-      set_value_optimized_out (result, value_optimized_out_const (val));
       return result;
     }
 }
@@ -737,8 +738,8 @@ lim_warning (const char *format, ...)
    i.e. if it would be a bad idea to allocate a value of this type in
    GDB.  */
 
-static void
-check_size (const struct type *type)
+void
+ada_ensure_varsize_limit (const struct type *type)
 {
   if (TYPE_LENGTH (type) > varsize_limit)
     error (_("object size is larger than varsize-limit"));
@@ -793,6 +794,7 @@ min_of_type (struct type *t)
 LONGEST
 ada_discrete_type_high_bound (struct type *type)
 {
+  type = resolve_dynamic_type (type, 0);
   switch (TYPE_CODE (type))
     {
     case TYPE_CODE_RANGE:
@@ -813,6 +815,7 @@ ada_discrete_type_high_bound (struct type *type)
 LONGEST
 ada_discrete_type_low_bound (struct type *type)
 {
+  type = resolve_dynamic_type (type, 0);
   switch (TYPE_CODE (type))
     {
     case TYPE_CODE_RANGE:
@@ -2047,7 +2050,7 @@ ada_coerce_to_simple_array (struct value *arr)
 
       if (arrVal == NULL)
         error (_("Bounds unavailable for null array pointer."));
-      check_size (TYPE_TARGET_TYPE (value_type (arrVal)));
+      ada_ensure_varsize_limit (TYPE_TARGET_TYPE (value_type (arrVal)));
       return value_ind (arrVal);
     }
   else if (ada_is_constrained_packed_array_type (value_type (arr)))
@@ -2149,7 +2152,15 @@ decode_packed_array_bitsize (struct type *type)
    but with the bit sizes of its elements (and those of any
    constituent arrays) recorded in the BITSIZE components of its
    TYPE_FIELD_BITSIZE values, and with *ELT_BITS set to its total size
-   in bits.  */
+   in bits.
+
+   Note that, for arrays whose index type has an XA encoding where
+   a bound references a record discriminant, getting that discriminant,
+   and therefore the actual value of that bound, is not possible
+   because none of the given parameters gives us access to the record.
+   This function assumes that it is OK in the context where it is being
+   used to return an array whose bounds are still dynamic and where
+   the length is arbitrary.  */
 
 static struct type *
 constrained_packed_array_type (struct type *type, long *elt_bits)
@@ -2179,7 +2190,9 @@ constrained_packed_array_type (struct type *type, long *elt_bits)
   TYPE_FIELD_BITSIZE (new_type, 0) = *elt_bits;
   TYPE_NAME (new_type) = ada_type_name (type);
 
-  if (get_discrete_bounds (index_type, &low_bound, &high_bound) < 0)
+  if ((TYPE_CODE (check_typedef (index_type)) == TYPE_CODE_RANGE
+       && is_dynamic_type (check_typedef (index_type)))
+      || get_discrete_bounds (index_type, &low_bound, &high_bound) < 0)
     low_bound = high_bound = 0;
   if (high_bound < low_bound)
     *elt_bits = TYPE_LENGTH (new_type) = 0;
@@ -2717,15 +2730,16 @@ ada_value_subscript (struct value *arr, int arity, struct value **ind)
   return elt;
 }
 
-/* Assuming ARR is a pointer to a standard GDB array of type TYPE, the
-   value of the element of *ARR at the ARITY indices given in
-   IND.  Does not read the entire array into memory.  */
+/* Assuming ARR is a pointer to a GDB array, the value of the element
+   of *ARR at the ARITY indices given in IND.
+   Does not read the entire array into memory.  */
 
 static struct value *
-ada_value_ptr_subscript (struct value *arr, struct type *type, int arity,
-                         struct value **ind)
+ada_value_ptr_subscript (struct value *arr, int arity, struct value **ind)
 {
   int k;
+  struct type *type
+    = check_typedef (value_enclosing_type (ada_value_ind (arr)));
 
   for (k = 0; k < arity; k += 1)
     {
@@ -2943,7 +2957,11 @@ ada_array_bound_from_type (struct type *arr_type, int n, int which)
 static LONGEST
 ada_array_bound (struct value *arr, int n, int which)
 {
-  struct type *arr_type = value_type (arr);
+  struct type *arr_type;
+
+  if (TYPE_CODE (check_typedef (value_type (arr))) == TYPE_CODE_PTR)
+    arr = value_ind (arr);
+  arr_type = value_enclosing_type (arr);
 
   if (ada_is_constrained_packed_array_type (arr_type))
     return ada_array_bound (decode_constrained_packed_array (arr), n, which);
@@ -2962,7 +2980,11 @@ ada_array_bound (struct value *arr, int n, int which)
 static LONGEST
 ada_array_length (struct value *arr, int n)
 {
-  struct type *arr_type = ada_check_typedef (value_type (arr));
+  struct type *arr_type;
+
+  if (TYPE_CODE (check_typedef (value_type (arr))) == TYPE_CODE_PTR)
+    arr = value_ind (arr);
+  arr_type = value_enclosing_type (arr);
 
   if (ada_is_constrained_packed_array_type (arr_type))
     return ada_array_length (decode_constrained_packed_array (arr), n);
@@ -3694,7 +3716,7 @@ See set/show multiple-symbol."));
             (SYMBOL_CLASS (syms[i].sym) == LOC_CONST
              && SYMBOL_TYPE (syms[i].sym) != NULL
              && TYPE_CODE (SYMBOL_TYPE (syms[i].sym)) == TYPE_CODE_ENUM);
-          struct symtab *symtab = SYMBOL_SYMTAB (syms[i].sym);
+          struct symtab *symtab = symbol_symtab (syms[i].sym);
 
           if (SYMBOL_LINE (syms[i].sym) != 0 && symtab != NULL)
             printf_unfiltered (_("[%d] %s at %s:%d\n"),
@@ -4165,7 +4187,7 @@ parse_old_style_renaming (struct type *type,
 
 static struct value *
 ada_read_renaming_var_value (struct symbol *renaming_sym,
-                            struct block *block)
+                            const struct block *block)
 {
   const char *sym_name;
   struct expression *expr;
@@ -4391,20 +4413,6 @@ ada_clear_symbol_cache (void)
   ada_init_symbol_cache (sym_cache);
 }
 
-/* STRUCT_DOMAIN symbols are also typedefs for the type.  This function tests
-   the equivalency of two Ada symbol domain types.  */
-
-static int
-ada_symbol_matches_domain (domain_enum symbol_domain, domain_enum domain)
-{
-  if (symbol_domain == domain
-      || ((domain == VAR_DOMAIN || domain == STRUCT_DOMAIN)
-         && symbol_domain == STRUCT_DOMAIN))
-    return 1;
-
-  return 0;
-}
-
 /* Search our cache for an entry matching NAME and NAMESPACE.
    Return it if found, or NULL otherwise.  */
 
@@ -4463,8 +4471,10 @@ cache_symbol (const char *name, domain_enum namespace, struct symbol *sym,
      the symbol is local or not, we check the block where we found it
      against the global and static blocks of its associated symtab.  */
   if (sym
-      && BLOCKVECTOR_BLOCK (BLOCKVECTOR (sym->symtab), GLOBAL_BLOCK) != block
-      && BLOCKVECTOR_BLOCK (BLOCKVECTOR (sym->symtab), STATIC_BLOCK) != block)
+      && BLOCKVECTOR_BLOCK (SYMTAB_BLOCKVECTOR (symbol_symtab (sym)),
+                           GLOBAL_BLOCK) != block
+      && BLOCKVECTOR_BLOCK (SYMTAB_BLOCKVECTOR (symbol_symtab (sym)),
+                           STATIC_BLOCK) != block)
     return;
 
   h = msymbol_hash (name) % HASH_SIZE;
@@ -4506,13 +4516,6 @@ standard_lookup (const char *name, const struct block *block,
   if (lookup_cached_symbol (name, domain, &sym, NULL))
     return sym;
   sym = lookup_symbol_in_language (name, block, domain, language_c, 0);
-
-  /* STRUCT_DOMAIN symbols also define a typedef for the type.  Lookup
-     a STRUCT_DOMAIN symbol if one is requested for VAR_DOMAIN and not
-     found.  */
-  if (sym == NULL && domain == VAR_DOMAIN)
-    sym = lookup_symbol_in_language (name, block, STRUCT_DOMAIN, language_c, 0);
-
   cache_symbol (name, domain, sym, block_found);
   return sym;
 }
@@ -5338,29 +5341,13 @@ add_nonlocal_symbols (struct obstack *obstackp, const char *name,
       data.objfile = objfile;
 
       if (is_wild_match)
-       {
-         objfile->sf->qf->map_matching_symbols (objfile, name, domain, global,
-                                                aux_add_nonlocal_symbols,
-                                                &data, wild_match, NULL);
-         if (domain == VAR_DOMAIN)
-           objfile->sf->qf->map_matching_symbols (objfile, name,
-                                                  STRUCT_DOMAIN, global,
-                                                  aux_add_nonlocal_symbols,
-                                                  &data, wild_match, NULL);
-       }
+       objfile->sf->qf->map_matching_symbols (objfile, name, domain, global,
+                                              aux_add_nonlocal_symbols, &data,
+                                              wild_match, NULL);
       else
-       {
-         objfile->sf->qf->map_matching_symbols (objfile, name, domain, global,
-                                                aux_add_nonlocal_symbols,
-                                                &data, full_match,
-                                                compare_names);
-         if (domain == VAR_DOMAIN)
-           objfile->sf->qf->map_matching_symbols (objfile, name,
-                                                  STRUCT_DOMAIN, global,
-                                                  aux_add_nonlocal_symbols,
-                                                  &data, full_match,
-                                                  compare_names);
-       }
+       objfile->sf->qf->map_matching_symbols (objfile, name, domain, global,
+                                              aux_add_nonlocal_symbols, &data,
+                                              full_match, compare_names);
     }
 
   if (num_defns_collected (obstackp) == 0 && global && !is_wild_match)
@@ -5884,7 +5871,8 @@ ada_add_block_symbols (struct obstack *obstackp,
       for (sym = block_iter_match_first (block, name, wild_match, &iter);
           sym != NULL; sym = block_iter_match_next (name, wild_match, &iter))
       {
-        if (ada_symbol_matches_domain (SYMBOL_DOMAIN (sym), domain)
+        if (symbol_matches_domain (SYMBOL_LANGUAGE (sym),
+                                   SYMBOL_DOMAIN (sym), domain)
             && wild_match (SYMBOL_LINKAGE_NAME (sym), name) == 0)
           {
            if (SYMBOL_CLASS (sym) == LOC_UNRESOLVED)
@@ -5906,7 +5894,8 @@ ada_add_block_symbols (struct obstack *obstackp,
      for (sym = block_iter_match_first (block, name, full_match, &iter);
          sym != NULL; sym = block_iter_match_next (name, full_match, &iter))
       {
-        if (ada_symbol_matches_domain (SYMBOL_DOMAIN (sym), domain))
+        if (symbol_matches_domain (SYMBOL_LANGUAGE (sym),
+                                   SYMBOL_DOMAIN (sym), domain))
           {
            if (SYMBOL_CLASS (sym) != LOC_UNRESOLVED)
              {
@@ -5938,7 +5927,8 @@ ada_add_block_symbols (struct obstack *obstackp,
 
       ALL_BLOCK_SYMBOLS (block, iter, sym)
       {
-        if (ada_symbol_matches_domain (SYMBOL_DOMAIN (sym), domain))
+        if (symbol_matches_domain (SYMBOL_LANGUAGE (sym),
+                                   SYMBOL_DOMAIN (sym), domain))
           {
             int cmp;
 
@@ -6161,10 +6151,10 @@ ada_make_symbol_completion_list (const char *text0, const char *word,
   int encoded_p;
   VEC(char_ptr) *completions = VEC_alloc (char_ptr, 128);
   struct symbol *sym;
-  struct symtab *s;
+  struct compunit_symtab *s;
   struct minimal_symbol *msymbol;
   struct objfile *objfile;
-  struct block *b, *surrounding_static_block = 0;
+  const struct block *b, *surrounding_static_block = 0;
   int i;
   struct block_iterator iter;
   struct cleanup *old_chain = make_cleanup (null_cleanup, NULL);
@@ -6242,10 +6232,10 @@ ada_make_symbol_completion_list (const char *text0, const char *word,
   /* Go through the symtabs and check the externs and statics for
      symbols which match.  */
 
-  ALL_SYMTABS (objfile, s)
+  ALL_COMPUNITS (objfile, s)
   {
     QUIT;
-    b = BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), GLOBAL_BLOCK);
+    b = BLOCKVECTOR_BLOCK (COMPUNIT_BLOCKVECTOR (s), GLOBAL_BLOCK);
     ALL_BLOCK_SYMBOLS (b, iter, sym)
     {
       symbol_completion_add (&completions, SYMBOL_LINKAGE_NAME (sym),
@@ -6254,10 +6244,10 @@ ada_make_symbol_completion_list (const char *text0, const char *word,
     }
   }
 
-  ALL_SYMTABS (objfile, s)
+  ALL_COMPUNITS (objfile, s)
   {
     QUIT;
-    b = BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), STATIC_BLOCK);
+    b = BLOCKVECTOR_BLOCK (COMPUNIT_BLOCKVECTOR (s), STATIC_BLOCK);
     /* Don't do this block twice.  */
     if (b == surrounding_static_block)
       continue;
@@ -7383,7 +7373,11 @@ ada_which_variant_applies (struct type *var_type, struct type *outer_type,
   struct value *discrim;
   LONGEST discrim_val;
 
-  outer = value_from_contents_and_address (outer_type, outer_valaddr, 0);
+  /* Using plain value_from_contents_and_address here causes problems
+     because we will end up trying to resolve a type that is currently
+     being constructed.  */
+  outer = value_from_contents_and_address_unresolved (outer_type,
+                                                     outer_valaddr, 0);
   discrim = ada_value_struct_elt (outer, discrim_name, 1);
   if (discrim == NULL)
     return -1;
@@ -7522,12 +7516,11 @@ ada_find_any_type_symbol (const char *name)
   struct symbol *sym;
 
   sym = standard_lookup (name, get_selected_block (NULL), VAR_DOMAIN);
-  if (sym != NULL
-      && (SYMBOL_DOMAIN (sym) != VAR_DOMAIN
-         || SYMBOL_CLASS (sym) == LOC_TYPEDEF))
+  if (sym != NULL && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
     return sym;
 
-  return NULL;
+  sym = standard_lookup (name, NULL, STRUCT_DOMAIN);
+  return sym;
 }
 
 /* Find a type named NAME.  Ignores ambiguity.  This routine will look
@@ -7922,8 +7915,14 @@ ada_template_to_fixed_record_type_1 (struct type *type,
                 initialized, the type size may be completely bogus and
                 GDB may fail to allocate a value for it.  So check the
                 size first before creating the value.  */
-             check_size (rtype);
-             dval = value_from_contents_and_address (rtype, valaddr, address);
+             ada_ensure_varsize_limit (rtype);
+             /* Using plain value_from_contents_and_address here
+                causes problems because we will end up trying to
+                resolve a type that is currently being
+                constructed.  */
+             dval = value_from_contents_and_address_unresolved (rtype,
+                                                                valaddr,
+                                                                address);
              rtype = value_type (dval);
            }
           else
@@ -7964,7 +7963,7 @@ ada_template_to_fixed_record_type_1 (struct type *type,
             large (due to an uninitialized variable in the inferior)
             that it would cause an overflow when adding it to the
             record size.  */
-         check_size (field_type);
+         ada_ensure_varsize_limit (field_type);
 
          TYPE_FIELD_TYPE (rtype, f) = field_type;
           TYPE_FIELD_NAME (rtype, f) = TYPE_FIELD_NAME (type, f);
@@ -8028,7 +8027,11 @@ ada_template_to_fixed_record_type_1 (struct type *type,
 
       if (dval0 == NULL)
        {
-         dval = value_from_contents_and_address (rtype, valaddr, address);
+         /* Using plain value_from_contents_and_address here causes
+            problems because we will end up trying to resolve a type
+            that is currently being constructed.  */
+         dval = value_from_contents_and_address_unresolved (rtype, valaddr,
+                                                            address);
          rtype = value_type (dval);
        }
       else
@@ -8312,6 +8315,79 @@ to_fixed_variant_branch_type (struct type *var_type0, const gdb_byte *valaddr,
     return TYPE_FIELD_TYPE (var_type, which);
 }
 
+/* Assuming RANGE_TYPE is a TYPE_CODE_RANGE, return nonzero if
+   ENCODING_TYPE, a type following the GNAT conventions for discrete
+   type encodings, only carries redundant information.  */
+
+static int
+ada_is_redundant_range_encoding (struct type *range_type,
+                                struct type *encoding_type)
+{
+  struct type *fixed_range_type;
+  char *bounds_str;
+  int n;
+  LONGEST lo, hi;
+
+  gdb_assert (TYPE_CODE (range_type) == TYPE_CODE_RANGE);
+
+  if (TYPE_CODE (get_base_type (range_type))
+      != TYPE_CODE (get_base_type (encoding_type)))
+    {
+      /* The compiler probably used a simple base type to describe
+        the range type instead of the range's actual base type,
+        expecting us to get the real base type from the encoding
+        anyway.  In this situation, the encoding cannot be ignored
+        as redundant.  */
+      return 0;
+    }
+
+  if (is_dynamic_type (range_type))
+    return 0;
+
+  if (TYPE_NAME (encoding_type) == NULL)
+    return 0;
+
+  bounds_str = strstr (TYPE_NAME (encoding_type), "___XDLU_");
+  if (bounds_str == NULL)
+    return 0;
+
+  n = 8; /* Skip "___XDLU_".  */
+  if (!ada_scan_number (bounds_str, n, &lo, &n))
+    return 0;
+  if (TYPE_LOW_BOUND (range_type) != lo)
+    return 0;
+
+  n += 2; /* Skip the "__" separator between the two bounds.  */
+  if (!ada_scan_number (bounds_str, n, &hi, &n))
+    return 0;
+  if (TYPE_HIGH_BOUND (range_type) != hi)
+    return 0;
+
+  return 1;
+}
+
+/* Given the array type ARRAY_TYPE, return nonzero if DESC_TYPE,
+   a type following the GNAT encoding for describing array type
+   indices, only carries redundant information.  */
+
+static int
+ada_is_redundant_index_type_desc (struct type *array_type,
+                                 struct type *desc_type)
+{
+  struct type *this_layer = check_typedef (array_type);
+  int i;
+
+  for (i = 0; i < TYPE_NFIELDS (desc_type); i++)
+    {
+      if (!ada_is_redundant_range_encoding (TYPE_INDEX_TYPE (this_layer),
+                                           TYPE_FIELD_TYPE (desc_type, i)))
+       return 0;
+      this_layer = check_typedef (TYPE_TARGET_TYPE (this_layer));
+    }
+
+  return 1;
+}
+
 /* Assuming that TYPE0 is an array type describing the type of a value
    at ADDR, and that DVAL describes a record containing any
    discriminants used in TYPE0, returns a type for the value that
@@ -8338,6 +8414,17 @@ to_fixed_array_type (struct type *type0, struct value *dval,
 
   index_type_desc = ada_find_parallel_type (type0, "___XA");
   ada_fixup_array_indexes_type (index_type_desc);
+  if (index_type_desc != NULL
+      && ada_is_redundant_index_type_desc (type0, index_type_desc))
+    {
+      /* Ignore this ___XA parallel type, as it does not bring any
+        useful information.  This allows us to avoid creating fixed
+        versions of the array's index types, which would be identical
+        to the original ones.  This, in turn, can also help avoid
+        the creation of fixed versions of the array itself.  */
+      index_type_desc = NULL;
+    }
+
   if (index_type_desc == NULL)
     {
       struct type *elt_type0 = ada_check_typedef (TYPE_TARGET_TYPE (type0));
@@ -10019,6 +10106,10 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
         return (value_from_longest
                  (value_type (arg1),
                   value_as_long (arg1) + value_as_long (arg2)));
+      if (TYPE_CODE (value_type (arg2)) == TYPE_CODE_PTR)
+        return (value_from_longest
+                 (value_type (arg2),
+                  value_as_long (arg1) + value_as_long (arg2)));
       if ((ada_is_fixed_point_type (value_type (arg1))
            || ada_is_fixed_point_type (value_type (arg2)))
           && value_type (arg1) != value_type (arg2))
@@ -10041,6 +10132,10 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
         return (value_from_longest
                  (value_type (arg1),
                   value_as_long (arg1) - value_as_long (arg2)));
+      if (TYPE_CODE (value_type (arg2)) == TYPE_CODE_PTR)
+        return (value_from_longest
+                 (value_type (arg2),
+                  value_as_long (arg1) - value_as_long (arg2)));
       if ((ada_is_fixed_point_type (value_type (arg1))
            || ada_is_fixed_point_type (value_type (arg2)))
           && value_type (arg1) != value_type (arg2))
@@ -10142,13 +10237,15 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
           *pos += 4;
           goto nosideret;
         }
-      else if (SYMBOL_DOMAIN (exp->elts[pc + 2].symbol) == UNDEF_DOMAIN)
+
+      if (SYMBOL_DOMAIN (exp->elts[pc + 2].symbol) == UNDEF_DOMAIN)
         /* Only encountered when an unresolved symbol occurs in a
            context other than a function call, in which case, it is
            invalid.  */
         error (_("Unexpected unresolved symbol, %s, during evaluation"),
                SYMBOL_PRINT_NAME (exp->elts[pc + 2].symbol));
-      else if (noside == EVAL_AVOID_SIDE_EFFECTS)
+
+      if (noside == EVAL_AVOID_SIDE_EFFECTS)
         {
           type = static_unwrap_type (SYMBOL_TYPE (exp->elts[pc + 2].symbol));
           /* Check to see if this is a tagged type.  We also need to handle
@@ -10159,63 +10256,72 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
           if (ada_is_tagged_type (type, 0)
               || (TYPE_CODE (type) == TYPE_CODE_REF
                   && ada_is_tagged_type (TYPE_TARGET_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);
-
-           if (TYPE_CODE (type) != TYPE_CODE_REF)
-             {
-               struct type *actual_type;
-
-               actual_type = type_from_tag (ada_value_tag (arg1));
-               if (actual_type == NULL)
-                 /* If, for some reason, we were unable to determine
-                    the actual type from the tag, then use the static
-                    approximation that we just computed as a fallback.
-                    This can happen if the debugging information is
-                    incomplete, for instance.  */
-                 actual_type = type;
-               return value_zero (actual_type, not_lval);
-             }
-           else
-             {
-               /* In the case of a ref, ada_coerce_ref takes care
-                  of determining the actual type.  But the evaluation
-                  should return a ref as it should be valid to ask
-                  for its address; so rebuild a ref after coerce.  */
-               arg1 = ada_coerce_ref (arg1);
-               return value_ref (arg1);
-             }
-          }
+           {
+             /* 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);
+
+             if (TYPE_CODE (type) != TYPE_CODE_REF)
+               {
+                 struct type *actual_type;
+
+                 actual_type = type_from_tag (ada_value_tag (arg1));
+                 if (actual_type == NULL)
+                   /* If, for some reason, we were unable to determine
+                      the actual type from the tag, then use the static
+                      approximation that we just computed as a fallback.
+                      This can happen if the debugging information is
+                      incomplete, for instance.  */
+                   actual_type = type;
+                 return value_zero (actual_type, not_lval);
+               }
+             else
+               {
+                 /* In the case of a ref, ada_coerce_ref takes care
+                    of determining the actual type.  But the evaluation
+                    should return a ref as it should be valid to ask
+                    for its address; so rebuild a ref after coerce.  */
+                 arg1 = ada_coerce_ref (arg1);
+                 return value_ref (arg1);
+               }
+           }
 
-          *pos += 4;
-          return value_zero
-            (to_static_fixed_type
-             (static_unwrap_type (SYMBOL_TYPE (exp->elts[pc + 2].symbol))),
-             not_lval);
-        }
-      else
-        {
-          arg1 = evaluate_subexp_standard (expect_type, exp, pos, noside);
-          return ada_to_fixed_value (arg1);
+         /* Records and unions for which GNAT encodings have been
+            generated need to be statically fixed as well.
+            Otherwise, non-static fixing produces a type where
+            all dynamic properties are removed, which prevents "ptype"
+            from being able to completely describe the type.
+            For instance, a case statement in a variant record would be
+            replaced by the relevant components based on the actual
+            value of the discriminants.  */
+         if ((TYPE_CODE (type) == TYPE_CODE_STRUCT
+              && dynamic_template_type (type) != NULL)
+             || (TYPE_CODE (type) == TYPE_CODE_UNION
+                 && ada_find_parallel_type (type, "___XVU") != NULL))
+           {
+             *pos += 4;
+             return value_zero (to_static_fixed_type (type), not_lval);
+           }
         }
 
+      arg1 = evaluate_subexp_standard (expect_type, exp, pos, noside);
+      return ada_to_fixed_value (arg1);
+
     case OP_FUNCALL:
       (*pos) += 2;
 
@@ -10335,9 +10441,9 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
                           (ada_coerce_to_simple_array (argvec[0]),
                            nargs, argvec + 1));
         case TYPE_CODE_PTR:     /* Pointer to array */
-          type = to_fixed_array_type (TYPE_TARGET_TYPE (type), NULL, 1);
           if (noside == EVAL_AVOID_SIDE_EFFECTS)
             {
+             type = to_fixed_array_type (TYPE_TARGET_TYPE (type), NULL, 1);
               type = ada_array_element_type (type, nargs);
               if (type == NULL)
                 error (_("element type of array unknown"));
@@ -10345,8 +10451,8 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
                 return value_zero (ada_aligned_type (type), lval_memory);
             }
           return
-            unwrap_value (ada_value_ptr_subscript (argvec[0], type,
-                                                   nargs, argvec + 1));
+            unwrap_value (ada_value_ptr_subscript (argvec[0],
+                                                  nargs, argvec + 1));
 
         default:
           error (_("Attempt to index or call something other than an "
@@ -10799,7 +10905,7 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
                    (ada_aligned_type
                     (ada_check_typedef (TYPE_TARGET_TYPE (type))));
                }
-             check_size (type);
+             ada_ensure_varsize_limit (type);
               return value_zero (type, lval_memory);
             }
           else if (TYPE_CODE (type) == TYPE_CODE_INT)
@@ -11518,8 +11624,8 @@ is_known_support_routine (struct frame_info *frame)
       re_comp (known_runtime_file_name_patterns[i]);
       if (re_exec (lbasename (sal.symtab->filename)))
         return 1;
-      if (sal.symtab->objfile != NULL
-          && re_exec (objfile_name (sal.symtab->objfile)))
+      if (SYMTAB_OBJFILE (sal.symtab) != NULL
+          && re_exec (objfile_name (SYMTAB_OBJFILE (sal.symtab))))
         return 1;
     }
 
@@ -12779,7 +12885,7 @@ static void
 ada_add_exceptions_from_frame (regex_t *preg, struct frame_info *frame,
                               VEC(ada_exc_info) **exceptions)
 {
-  struct block *block = get_frame_block (frame, 0);
+  const struct block *block = get_frame_block (frame, 0);
 
   while (block != 0)
     {
@@ -12833,14 +12939,14 @@ static void
 ada_add_global_exceptions (regex_t *preg, VEC(ada_exc_info) **exceptions)
 {
   struct objfile *objfile;
-  struct symtab *s;
+  struct compunit_symtab *s;
 
   expand_symtabs_matching (NULL, ada_exc_search_name_matches,
                           VARIABLES_DOMAIN, preg);
 
-  ALL_PRIMARY_SYMTABS (objfile, s)
+  ALL_COMPUNITS (objfile, s)
     {
-      struct blockvector *bv = BLOCKVECTOR (s);
+      const struct blockvector *bv = COMPUNIT_BLOCKVECTOR (s);
       int i;
 
       for (i = GLOBAL_BLOCK; i <= STATIC_BLOCK; i++)
@@ -13465,7 +13571,7 @@ ada_get_symbol_name_cmp (const char *lookup_name)
 static struct value *
 ada_read_var_value (struct symbol *var, struct frame_info *frame)
 {
-  struct block *frame_block = NULL;
+  const struct block *frame_block = NULL;
   struct symbol *renaming_sym = NULL;
 
   /* The only case where default_read_var_value is not sufficient
@@ -13522,6 +13628,8 @@ const struct language_defn ada_language_defn = {
   ada_get_symbol_name_cmp,     /* la_get_symbol_name_cmp */
   ada_iterate_over_symbols,
   &ada_varobj_ops,
+  NULL,
+  NULL,
   LANG_MAGIC
 };
 
@@ -13539,7 +13647,7 @@ set_ada_command (char *arg, int from_tty)
 {
   printf_unfiltered (_(\
 "\"set ada\" must be followed by the name of a setting.\n"));
-  help_list (set_ada_list, "set ada ", -1, gdb_stdout);
+  help_list (set_ada_list, "set ada ", all_commands, gdb_stdout);
 }
 
 /* Implement the "show ada" prefix command.  */
This page took 0.040555 seconds and 4 git commands to generate.