2012-03-01 Pedro Alves <palves@redhat.com>
[deliverable/binutils-gdb.git] / gdb / ada-lang.c
index de165fadf8df7759e51525d56b07f2c7acdccb6c..4c17eaaae390a3682fd19b70a5a332bca8be0872 100644 (file)
@@ -223,7 +223,7 @@ static struct value *ada_search_struct_field (char *, struct value *, int,
 static struct value *ada_value_primitive_field (struct value *, int, int,
                                                 struct type *);
 
-static int find_struct_field (char *, struct type *, int,
+static int find_struct_field (const char *, struct type *, int,
                               struct type **, int *, int *, int *, int *);
 
 static struct value *ada_to_fixed_value_create (struct type *, CORE_ADDR,
@@ -271,6 +271,8 @@ static struct value *ada_evaluate_subexp (struct type *, struct expression *,
 
 static void ada_forward_operator_length (struct expression *, int, int *,
                                         int *);
+
+static struct type *ada_find_any_type (const char *name);
 \f
 
 
@@ -733,6 +735,46 @@ get_base_type (struct type *type)
     }
   return type;
 }
+
+/* Return a decoded version of the given VALUE.  This means returning
+   a value whose type is obtained by applying all the GNAT-specific
+   encondings, making the resulting type a static but standard description
+   of the initial type.  */
+
+struct value *
+ada_get_decoded_value (struct value *value)
+{
+  struct type *type = ada_check_typedef (value_type (value));
+
+  if (ada_is_array_descriptor_type (type)
+      || (ada_is_constrained_packed_array_type (type)
+          && TYPE_CODE (type) != TYPE_CODE_PTR))
+    {
+      if (TYPE_CODE (type) == TYPE_CODE_TYPEDEF)  /* array access type.  */
+        value = ada_coerce_to_simple_array_ptr (value);
+      else
+        value = ada_coerce_to_simple_array (value);
+    }
+  else
+    value = ada_to_fixed_value (value);
+
+  return value;
+}
+
+/* Same as ada_get_decoded_value, but with the given TYPE.
+   Because there is no associated actual value for this type,
+   the resulting type might be a best-effort approximation in
+   the case of dynamic types.  */
+
+struct type *
+ada_get_decoded_type (struct type *type)
+{
+  type = to_static_fixed_type (type);
+  if (ada_is_constrained_packed_array_type (type))
+    type = ada_coerce_to_simple_array_type (type);
+  return type;
+}
+
 \f
 
                                 /* Language Selection */
@@ -1370,7 +1412,7 @@ ada_fixup_array_indexes_type (struct type *index_desc_type)
   /* Fixup each field of INDEX_DESC_TYPE.  */
   for (i = 0; i < TYPE_NFIELDS (index_desc_type); i++)
    {
-     char *name = TYPE_FIELD_NAME (index_desc_type, i);
+     const char *name = TYPE_FIELD_NAME (index_desc_type, i);
      struct type *raw_type = ada_check_typedef (ada_find_any_type (name));
 
      if (raw_type)
@@ -1962,8 +2004,8 @@ ada_is_unconstrained_packed_array_type (struct type *type)
 static long
 decode_packed_array_bitsize (struct type *type)
 {
-  char *raw_name;
-  char *tail;
+  const char *raw_name;
+  const char *tail;
   long bits;
 
   /* Access to arrays implemented as fat pointers are encoded as a typedef
@@ -2006,22 +2048,30 @@ constrained_packed_array_type (struct type *type, long *elt_bits)
 {
   struct type *new_elt_type;
   struct type *new_type;
+  struct type *index_type_desc;
+  struct type *index_type;
   LONGEST low_bound, high_bound;
 
   type = ada_check_typedef (type);
   if (TYPE_CODE (type) != TYPE_CODE_ARRAY)
     return type;
 
+  index_type_desc = ada_find_parallel_type (type, "___XA");
+  if (index_type_desc)
+    index_type = to_fixed_range_type (TYPE_FIELD_TYPE (index_type_desc, 0),
+                                     NULL);
+  else
+    index_type = TYPE_INDEX_TYPE (type);
+
   new_type = alloc_type_copy (type);
   new_elt_type =
     constrained_packed_array_type (ada_check_typedef (TYPE_TARGET_TYPE (type)),
                                   elt_bits);
-  create_array_type (new_type, new_elt_type, TYPE_INDEX_TYPE (type));
+  create_array_type (new_type, new_elt_type, index_type);
   TYPE_FIELD_BITSIZE (new_type, 0) = *elt_bits;
   TYPE_NAME (new_type) = ada_type_name (type);
 
-  if (get_discrete_bounds (TYPE_INDEX_TYPE (type),
-                           &low_bound, &high_bound) < 0)
+  if (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;
@@ -2042,9 +2092,9 @@ constrained_packed_array_type (struct type *type, long *elt_bits)
 static struct type *
 decode_constrained_packed_array_type (struct type *type)
 {
-  char *raw_name = ada_type_name (ada_check_typedef (type));
+  const char *raw_name = ada_type_name (ada_check_typedef (type));
   char *name;
-  char *tail;
+  const char *tail;
   struct type *shadow_type;
   long bits;
 
@@ -3407,7 +3457,7 @@ ada_resolve_function (struct ada_symbol_info syms[],
    such symbols by their trailing number (__N  or $N).  */
 
 static int
-encoded_ordered_before (char *N0, char *N1)
+encoded_ordered_before (const char *N0, const char *N1)
 {
   if (N1 == NULL)
     return 0;
@@ -4248,8 +4298,8 @@ lesseq_defined_than (struct symbol *sym0, struct symbol *sym1)
       {
         struct type *type0 = SYMBOL_TYPE (sym0);
         struct type *type1 = SYMBOL_TYPE (sym1);
-        char *name0 = SYMBOL_LINKAGE_NAME (sym0);
-        char *name1 = SYMBOL_LINKAGE_NAME (sym1);
+        const char *name0 = SYMBOL_LINKAGE_NAME (sym0);
+        const char *name1 = SYMBOL_LINKAGE_NAME (sym1);
         int len0 = strlen (name0);
 
         return
@@ -4380,7 +4430,7 @@ add_symbols_from_enclosing_procs (struct obstack *obstackp,
 static int
 is_nondebugging_type (struct type *type)
 {
-  char *name = ada_type_name (type);
+  const char *name = ada_type_name (type);
 
   return (name != NULL && strcmp (name, "<variable, no debug info>") == 0);
 }
@@ -4411,8 +4461,8 @@ ada_identical_enum_types_p (struct type *type1, struct type *type2)
      suffix).  */
   for (i = 0; i < TYPE_NFIELDS (type1); i++)
     {
-      char *name_1 = TYPE_FIELD_NAME (type1, i);
-      char *name_2 = TYPE_FIELD_NAME (type2, i);
+      const char *name_1 = TYPE_FIELD_NAME (type1, i);
+      const char *name_2 = TYPE_FIELD_NAME (type2, i);
       int len_1 = strlen (name_1);
       int len_2 = strlen (name_2);
 
@@ -4647,7 +4697,7 @@ is_package_name (const char *name)
    not visible from FUNCTION_NAME.  */
 
 static int
-old_renaming_is_invisible (const struct symbol *sym, char *function_name)
+old_renaming_is_invisible (const struct symbol *sym, const char *function_name)
 {
   char *scope;
 
@@ -4717,7 +4767,7 @@ remove_irrelevant_renamings (struct ada_symbol_info *syms,
                             int nsyms, const struct block *current_block)
 {
   struct symbol *current_function;
-  char *current_function_name;
+  const char *current_function_name;
   int i;
   int is_new_style_renaming;
 
@@ -5061,10 +5111,10 @@ done:
 
   ndefns = remove_extra_symbols (*results, ndefns);
 
-  if (ndefns == 0)
+  if (ndefns == 0 && full_search)
     cache_symbol (name0, namespace, NULL, NULL);
 
-  if (ndefns == 1 && cacheIfUnique)
+  if (ndefns == 1 && full_search && cacheIfUnique)
     cache_symbol (name0, namespace, (*results)[0].sym, (*results)[0].block);
 
   ndefns = remove_irrelevant_renamings (*results, ndefns, block0);
@@ -5102,7 +5152,7 @@ ada_name_for_lookup (const char *name)
 static void
 ada_iterate_over_symbols (const struct block *block,
                          const char *name, domain_enum domain,
-                         int (*callback) (struct symbol *, void *),
+                         symbol_found_callback_ftype *callback,
                          void *data)
 {
   int ndefs, i;
@@ -5854,7 +5904,7 @@ ada_make_symbol_completion_list (char *text0, char *word)
 static int
 ada_is_dispatch_table_ptr_type (struct type *type)
 {
-  char *name;
+  const char *name;
 
   if (TYPE_CODE (type) != TYPE_CODE_PTR)
     return 0;
@@ -5874,7 +5924,7 @@ ada_is_ignored_field (struct type *type, int field_num)
 {
   if (field_num < 0 || field_num > TYPE_NFIELDS (type))
     return 1;
-   
+
   /* Check the name of that field.  */
   {
     const char *name = TYPE_FIELD_NAME (type, field_num);
@@ -5885,8 +5935,13 @@ ada_is_ignored_field (struct type *type, int field_num)
     if (name == NULL)
       return 1;
 
-    /* A field named "_parent" is internally generated by GNAT for
-       tagged types, and should not be printed either.  */
+    /* Normally, fields whose name start with an underscore ("_")
+       are fields that have been internally generated by the compiler,
+       and thus should not be printed.  The "_parent" field is special,
+       however: This is a field internally generated by the compiler
+       for tagged types, and it contains the components inherited from
+       the parent type.  This field should not be printed as is, but
+       should not be ignored either.  */
     if (name[0] == '_' && strncmp (name, "_parent", 7) != 0)
       return 1;
   }
@@ -5976,105 +6031,110 @@ type_from_tag (struct value *tag)
   return NULL;
 }
 
-struct tag_args
+/* Return the "ada__tags__type_specific_data" type.  */
+
+static struct type *
+ada_get_tsd_type (struct inferior *inf)
 {
-  struct value *tag;
-  char *name;
-};
+  struct ada_inferior_data *data = get_ada_inferior_data (inf);
 
+  if (data->tsd_type == 0)
+    data->tsd_type = ada_find_any_type ("ada__tags__type_specific_data");
+  return data->tsd_type;
+}
 
-static int ada_tag_name_1 (void *);
-static int ada_tag_name_2 (struct tag_args *);
+/* Return the TSD (type-specific data) associated to the given TAG.
+   TAG is assumed to be the tag of a tagged-type entity.
 
-/* Wrapper function used by ada_tag_name.  Given a struct tag_args*
-   value ARGS, sets ARGS->name to the tag name of ARGS->tag.
-   The value stored in ARGS->name is valid until the next call to 
-   ada_tag_name_1.  */
+   May return NULL if we are unable to get the TSD.  */
 
-static int
-ada_tag_name_1 (void *args0)
+static struct value *
+ada_get_tsd_from_tag (struct value *tag)
 {
-  struct tag_args *args = (struct tag_args *) args0;
-  static char name[1024];
-  char *p;
   struct value *val;
+  struct type *type;
 
-  args->name = NULL;
-  val = ada_value_struct_elt (args->tag, "tsd", 1);
-  if (val == NULL)
-    return ada_tag_name_2 (args);
-  val = ada_value_struct_elt (val, "expanded_name", 1);
-  if (val == NULL)
-    return 0;
-  read_memory_string (value_as_address (val), name, sizeof (name) - 1);
-  for (p = name; *p != '\0'; p += 1)
-    if (isalpha (*p))
-      *p = tolower (*p);
-  args->name = name;
-  return 0;
-}
+  /* First option: The TSD is simply stored as a field of our TAG.
+     Only older versions of GNAT would use this format, but we have
+     to test it first, because there are no visible markers for
+     the current approach except the absence of that field.  */
 
-/* Return the "ada__tags__type_specific_data" type.  */
+  val = ada_value_struct_elt (tag, "tsd", 1);
+  if (val)
+    return val;
 
-static struct type *
-ada_get_tsd_type (struct inferior *inf)
-{
-  struct ada_inferior_data *data = get_ada_inferior_data (inf);
+  /* Try the second representation for the dispatch table (in which
+     there is no explicit 'tsd' field in the referent of the tag pointer,
+     and instead the tsd pointer is stored just before the dispatch
+     table.  */
 
-  if (data->tsd_type == 0)
-    data->tsd_type = ada_find_any_type ("ada__tags__type_specific_data");
-  return data->tsd_type;
+  type = ada_get_tsd_type (current_inferior());
+  if (type == NULL)
+    return NULL;
+  type = lookup_pointer_type (lookup_pointer_type (type));
+  val = value_cast (type, tag);
+  if (val == NULL)
+    return NULL;
+  return value_ind (value_ptradd (val, -1));
 }
 
-/* Utility function for ada_tag_name_1 that tries the second
-   representation for the dispatch table (in which there is no
-   explicit 'tsd' field in the referent of the tag pointer, and instead
-   the tsd pointer is stored just before the dispatch table.  */
-   
-static int
-ada_tag_name_2 (struct tag_args *args)
+/* Given the TSD of a tag (type-specific data), return a string
+   containing the name of the associated type.
+
+   The returned value is good until the next call.  May return NULL
+   if we are unable to determine the tag name.  */
+
+static char *
+ada_tag_name_from_tsd (struct value *tsd)
 {
-  struct type *info_type;
   static char name[1024];
   char *p;
-  struct value *val, *valp;
+  struct value *val;
 
-  args->name = NULL;
-  info_type = ada_get_tsd_type (current_inferior());
-  if (info_type == NULL)
-    return 0;
-  info_type = lookup_pointer_type (lookup_pointer_type (info_type));
-  valp = value_cast (info_type, args->tag);
-  if (valp == NULL)
-    return 0;
-  val = value_ind (value_ptradd (valp, -1));
+  val = ada_value_struct_elt (tsd, "expanded_name", 1);
   if (val == NULL)
-    return 0;
-  val = ada_value_struct_elt (val, "expanded_name", 1);
-  if (val == NULL)
-    return 0;
+    return NULL;
   read_memory_string (value_as_address (val), name, sizeof (name) - 1);
   for (p = name; *p != '\0'; p += 1)
     if (isalpha (*p))
       *p = tolower (*p);
-  args->name = name;
-  return 0;
+  return name;
 }
 
 /* The type name of the dynamic type denoted by the 'tag value TAG, as
-   a C string.  */
+   a C string.
+
+   Return NULL if the TAG is not an Ada tag, or if we were unable to
+   determine the name of that tag.  The result is good until the next
+   call.  */
 
 const char *
 ada_tag_name (struct value *tag)
 {
-  struct tag_args args;
+  volatile struct gdb_exception e;
+  char *name = NULL;
 
   if (!ada_is_tag_type (value_type (tag)))
     return NULL;
-  args.tag = tag;
-  args.name = NULL;
-  catch_errors (ada_tag_name_1, &args, NULL, RETURN_MASK_ALL);
-  return args.name;
+
+  /* It is perfectly possible that an exception be raised while trying
+     to determine the TAG's name, even under normal circumstances:
+     The associated variable may be uninitialized or corrupted, for
+     instance. We do not let any exception propagate past this point.
+     instead we return NULL.
+
+     We also do not print the error message either (which often is very
+     low-level (Eg: "Cannot read memory at 0x[...]"), but instead let
+     the caller print a more meaningful message if necessary.  */
+  TRY_CATCH (e, RETURN_MASK_ERROR)
+    {
+      struct value *tsd = ada_get_tsd_from_tag (tag);
+
+      if (tsd != NULL)
+       name = ada_tag_name_from_tsd (tsd);
+    }
+
+  return name;
 }
 
 /* The parent type of TYPE, or NULL if none.  */
@@ -6367,7 +6427,7 @@ ada_value_primitive_field (struct value *arg1, int offset, int fieldno,
    Returns 1 if found, 0 otherwise.  */
 
 static int
-find_struct_field (char *name, struct type *type, int offset,
+find_struct_field (const char *name, struct type *type, int offset,
                    struct type **field_type_p,
                    int *byte_offset_p, int *bit_offset_p, int *bit_size_p,
                   int *index_p)
@@ -6389,7 +6449,7 @@ find_struct_field (char *name, struct type *type, int offset,
     {
       int bit_pos = TYPE_FIELD_BITPOS (type, i);
       int fld_offset = offset + bit_pos / 8;
-      char *t_field_name = TYPE_FIELD_NAME (type, i);
+      const char *t_field_name = TYPE_FIELD_NAME (type, i);
 
       if (t_field_name == NULL)
         continue;
@@ -6466,7 +6526,7 @@ ada_search_struct_field (char *name, struct value *arg, int offset,
   type = ada_check_typedef (type);
   for (i = 0; i < TYPE_NFIELDS (type); i += 1)
     {
-      char *t_field_name = TYPE_FIELD_NAME (type, i);
+      const char *t_field_name = TYPE_FIELD_NAME (type, i);
 
       if (t_field_name == NULL)
         continue;
@@ -6725,7 +6785,7 @@ ada_lookup_struct_elt_type (struct type *type, char *name, int refok,
 
   for (i = 0; i < TYPE_NFIELDS (type); i += 1)
     {
-      char *t_field_name = TYPE_FIELD_NAME (type, i);
+      const char *t_field_name = TYPE_FIELD_NAME (type, i);
       struct type *t;
       int disp;
 
@@ -6764,7 +6824,7 @@ ada_lookup_struct_elt_type (struct type *type, char *name, int refok,
                 NOT wrapped in a struct, since the compiler sometimes
                 generates these for unchecked variant types.  Revisit
                 if the compiler changes this practice.  */
-             char *v_field_name = TYPE_FIELD_NAME (field_type, j);
+             const char *v_field_name = TYPE_FIELD_NAME (field_type, j);
               disp = 0;
              if (v_field_name != NULL 
                  && field_name_match (v_field_name, name))
@@ -6902,7 +6962,7 @@ ada_which_variant_applies (struct type *var_type, struct type *outer_type,
 struct value *
 ada_value_ind (struct value *val0)
 {
-  struct value *val = unwrap_value (value_ind (val0));
+  struct value *val = value_ind (val0);
 
   return ada_to_fixed_value (val);
 }
@@ -6918,7 +6978,6 @@ ada_coerce_ref (struct value *val0)
       struct value *val = val0;
 
       val = coerce_ref (val);
-      val = unwrap_value (val);
       return ada_to_fixed_value (val);
     }
   else
@@ -6965,10 +7024,10 @@ field_alignment (struct type *type, int f)
   return atoi (name + align_offset) * TARGET_CHAR_BIT;
 }
 
-/* Find a symbol named NAME.  Ignores ambiguity.  */
+/* Find a typedef or tag symbol named NAME.  Ignores ambiguity.  */
 
-struct symbol *
-ada_find_any_symbol (const char *name)
+static struct symbol *
+ada_find_any_type_symbol (const char *name)
 {
   struct symbol *sym;
 
@@ -6984,10 +7043,10 @@ ada_find_any_symbol (const char *name)
    solely for types defined by debug info, it will not search the GDB
    primitive types.  */
 
-struct type *
+static struct type *
 ada_find_any_type (const char *name)
 {
-  struct symbol *sym = ada_find_any_symbol (name);
+  struct symbol *sym = ada_find_any_type_symbol (name);
 
   if (sym != NULL)
     return SYMBOL_TYPE (sym);
@@ -6995,23 +7054,28 @@ ada_find_any_type (const char *name)
   return NULL;
 }
 
-/* Given NAME and an associated BLOCK, search all symbols for
-   NAME suffixed with  "___XR", which is the ``renaming'' symbol
-   associated to NAME.  Return this symbol if found, return
-   NULL otherwise.  */
+/* Given NAME_SYM and an associated BLOCK, find a "renaming" symbol
+   associated with NAME_SYM's name.  NAME_SYM may itself be a renaming
+   symbol, in which case it is returned.  Otherwise, this looks for
+   symbols whose name is that of NAME_SYM suffixed with  "___XR".
+   Return symbol if found, and NULL otherwise.  */
 
 struct symbol *
-ada_find_renaming_symbol (const char *name, struct block *block)
+ada_find_renaming_symbol (struct symbol *name_sym, struct block *block)
 {
+  const char *name = SYMBOL_LINKAGE_NAME (name_sym);
   struct symbol *sym;
 
+  if (strstr (name, "___XR") != NULL)
+     return name_sym;
+
   sym = find_old_style_renaming_symbol (name, block);
 
   if (sym != NULL)
     return sym;
 
   /* Not right yet.  FIXME pnh 7/20/2007.  */
-  sym = ada_find_any_symbol (name);
+  sym = ada_find_any_type_symbol (name);
   if (sym != NULL && strstr (SYMBOL_LINKAGE_NAME (sym), "___XR") != NULL)
     return sym;
   else
@@ -7030,7 +7094,7 @@ find_old_style_renaming_symbol (const char *name, struct block *block)
          qualified.  This means we need to prepend the function name
          as well as adding the ``___XR'' suffix to build the name of
          the associated renaming symbol.  */
-      char *function_name = SYMBOL_LINKAGE_NAME (function_sym);
+      const char *function_name = SYMBOL_LINKAGE_NAME (function_sym);
       /* Function names sometimes contain suffixes used
          for instance to qualify nested subprograms.  When building
          the XR type name, we need to make sure that this suffix is
@@ -7069,7 +7133,7 @@ find_old_style_renaming_symbol (const char *name, struct block *block)
       xsnprintf (rename, rename_len * sizeof (char), "%s___XR", name);
     }
 
-  return ada_find_any_symbol (rename);
+  return ada_find_any_type_symbol (rename);
 }
 
 /* Because of GNAT encoding conventions, several GDB symbols may match a
@@ -7110,7 +7174,7 @@ ada_prefer_type (struct type *type0, struct type *type1)
 /* The name of TYPE, which is either its TYPE_NAME, or, if that is
    null, its TYPE_TAG_NAME.  Null if TYPE is null.  */
 
-char *
+const char *
 ada_type_name (struct type *type)
 {
   if (type == NULL)
@@ -7137,7 +7201,7 @@ find_parallel_type_by_descriptive_type (struct type *type, const char *name)
   result = TYPE_DESCRIPTIVE_TYPE (type);
   while (result != NULL)
     {
-      char *result_name = ada_type_name (result);
+      const char *result_name = ada_type_name (result);
 
       if (result_name == NULL)
         {
@@ -7189,7 +7253,8 @@ ada_find_parallel_type_with_name (struct type *type, const char *name)
 struct type *
 ada_find_parallel_type (struct type *type, const char *suffix)
 {
-  char *name, *typename = ada_type_name (type);
+  char *name;
+  const char *typename = ada_type_name (type);
   int len;
 
   if (typename == NULL)
@@ -7825,6 +7890,11 @@ to_fixed_array_type (struct type *type0, struct value *dval,
         error (_("array type with dynamic size is larger than varsize-limit"));
     }
 
+  /* We want to preserve the type name.  This can be useful when
+     trying to get the type name of a value that has already been
+     printed (for instance, if the user did "print VAR; whatis $".  */
+  TYPE_NAME (result) = TYPE_NAME (type0);
+
   if (constrained_packed_array_p)
     {
       /* So far, the resulting type has been created as if the original
@@ -7895,7 +7965,7 @@ ada_to_fixed_type_1 (struct type *type, const gdb_byte *valaddr,
            If there is, then it provides the actual size of our type.  */
         else if (ada_type_name (fixed_record_type) != NULL)
           {
-            char *name = ada_type_name (fixed_record_type);
+            const char *name = ada_type_name (fixed_record_type);
             char *xvz_name = alloca (strlen (name) + 7 /* "___XVZ\0" */);
             int xvz_found = 0;
             LONGEST size;
@@ -8090,7 +8160,7 @@ ada_check_typedef (struct type *type)
     return type;
   else
     {
-      char *name = TYPE_TAG_NAME (type);
+      const char *name = TYPE_TAG_NAME (type);
       struct type *type1 = ada_find_any_type (name);
 
       if (type1 == NULL)
@@ -8132,9 +8202,11 @@ ada_to_fixed_value_create (struct type *type0, CORE_ADDR address,
 struct value *
 ada_to_fixed_value (struct value *val)
 {
-  return ada_to_fixed_value_create (value_type (val),
-                                    value_address (val),
-                                    val);
+  val = unwrap_value (val);
+  val = ada_to_fixed_value_create (value_type (val),
+                                     value_address (val),
+                                     val);
+  return val;
 }
 \f
 
@@ -8696,7 +8768,7 @@ assign_component (struct value *container, struct value *lhs, LONGEST index,
   else
     {
       elt = ada_index_struct_field (index, lhs, 0, value_type (lhs));
-      elt = ada_to_fixed_value (unwrap_value (elt));
+      elt = ada_to_fixed_value (elt);
     }
 
   if (exp->elts[*pos].opcode == OP_AGGREGATE)
@@ -8870,7 +8942,7 @@ aggregate_assign_from_choices (struct value *container,
       else
        {
          int ind;
-         char *name;
+         const char *name;
 
          switch (op)
            {
@@ -9533,7 +9605,6 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
       else
         {
           arg1 = evaluate_subexp_standard (expect_type, exp, pos, noside);
-          arg1 = unwrap_value (arg1);
           return ada_to_fixed_value (arg1);
         }
 
@@ -9879,7 +9950,7 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
         else if (discrete_type_p (type_arg))
           {
             struct type *range_type;
-            char *name = ada_type_name (type_arg);
+            const char *name = ada_type_name (type_arg);
 
             range_type = NULL;
             if (name != NULL && TYPE_CODE (type_arg) != TYPE_CODE_ENUM)
@@ -10411,7 +10482,7 @@ get_int_var_value (char *name, int *flag)
 static struct type *
 to_fixed_range_type (struct type *raw_type, struct value *dval)
 {
-  char *name;
+  const char *name;
   struct type *base_type;
   char *subtype_info;
 
@@ -10527,37 +10598,6 @@ ada_is_modular_type (struct type *type)
           && TYPE_UNSIGNED (subranged_type));
 }
 
-/* Try to determine the lower and upper bounds of the given modular type
-   using the type name only.  Return non-zero and set L and U as the lower
-   and upper bounds (respectively) if successful.  */
-
-int
-ada_modulus_from_name (struct type *type, ULONGEST *modulus)
-{
-  char *name = ada_type_name (type);
-  char *suffix;
-  int k;
-  LONGEST U;
-
-  if (name == NULL)
-    return 0;
-
-  /* Discrete type bounds are encoded using an __XD suffix.  In our case,
-     we are looking for static bounds, which means an __XDLU suffix.
-     Moreover, we know that the lower bound of modular types is always
-     zero, so the actual suffix should start with "__XDLU_0__", and
-     then be followed by the upper bound value.  */
-  suffix = strstr (name, "__XDLU_0__");
-  if (suffix == NULL)
-    return 0;
-  k = 10;
-  if (!ada_scan_number (suffix, k, &U, NULL))
-    return 0;
-
-  *modulus = (ULONGEST) U + 1;
-  return 1;
-}
-
 /* Assuming ada_is_modular_type (TYPE), the modulus of TYPE.  */
 
 ULONGEST
@@ -10781,7 +10821,7 @@ static int
 is_known_support_routine (struct frame_info *frame)
 {
   struct symtab_and_line sal;
-  char *func_name;
+  const char *func_name;
   enum language func_lang;
   int i;
 
@@ -10884,7 +10924,7 @@ ada_unhandled_exception_name_addr_from_raise (void)
 
   while (fi != NULL)
     {
-      char *func_name;
+      const char *func_name;
       enum language func_lang;
 
       find_frame_funname (fi, &func_name, &func_lang, NULL);
@@ -11563,23 +11603,52 @@ ada_get_next_arg (char **argsp)
 /* Split the arguments specified in a "catch exception" command.  
    Set EX to the appropriate catchpoint type.
    Set EXCEP_STRING to the name of the specific exception if
-   specified by the user.  */
+   specified by the user.
+   If a condition is found at the end of the arguments, the condition
+   expression is stored in COND_STRING (memory must be deallocated
+   after use).  Otherwise COND_STRING is set to NULL.  */
 
 static void
 catch_ada_exception_command_split (char *args,
                                    enum exception_catchpoint_kind *ex,
-                                   char **excep_string)
+                                  char **excep_string,
+                                  char **cond_string)
 {
   struct cleanup *old_chain = make_cleanup (null_cleanup, NULL);
   char *exception_name;
+  char *cond = NULL;
 
   exception_name = ada_get_next_arg (&args);
+  if (exception_name != NULL && strcmp (exception_name, "if") == 0)
+    {
+      /* This is not an exception name; this is the start of a condition
+        expression for a catchpoint on all exceptions.  So, "un-get"
+        this token, and set exception_name to NULL.  */
+      xfree (exception_name);
+      exception_name = NULL;
+      args -= 2;
+    }
   make_cleanup (xfree, exception_name);
 
-  /* Check that we do not have any more arguments.  Anything else
-     is unexpected.  */
+  /* Check to see if we have a condition.  */
 
   args = skip_spaces (args);
+  if (strncmp (args, "if", 2) == 0
+      && (isspace (args[2]) || args[2] == '\0'))
+    {
+      args += 2;
+      args = skip_spaces (args);
+
+      if (args[0] == '\0')
+        error (_("Condition missing after `if' keyword"));
+      cond = xstrdup (args);
+      make_cleanup (xfree, cond);
+
+      args += strlen (args);
+    }
+
+  /* Check that we do not have any more arguments.  Anything else
+     is unexpected.  */
 
   if (args[0] != '\0')
     error (_("Junk at end of expression"));
@@ -11604,6 +11673,7 @@ catch_ada_exception_command_split (char *args,
       *ex = ex_catch_exception;
       *excep_string = exception_name;
     }
+  *cond_string = cond;
 }
 
 /* Return the name of the symbol on which we should break in order to
@@ -11747,17 +11817,22 @@ ada_exception_sal (enum exception_catchpoint_kind ex, char *excep_string,
    If the user asked the catchpoint to catch only a specific
    exception, then save the exception name in ADDR_STRING.
 
+   If the user provided a condition, then set COND_STRING to
+   that condition expression (the memory must be deallocated
+   after use).  Otherwise, set COND_STRING to NULL.
+
    See ada_exception_sal for a description of all the remaining
    function arguments of this function.  */
 
 static struct symtab_and_line
 ada_decode_exception_location (char *args, char **addr_string,
                                char **excep_string,
+                              char **cond_string,
                                const struct breakpoint_ops **ops)
 {
   enum exception_catchpoint_kind ex;
 
-  catch_ada_exception_command_split (args, &ex, excep_string);
+  catch_ada_exception_command_split (args, &ex, excep_string, cond_string);
   return ada_exception_sal (ex, *excep_string, addr_string, ops);
 }
 
@@ -11768,6 +11843,7 @@ create_ada_exception_catchpoint (struct gdbarch *gdbarch,
                                 struct symtab_and_line sal,
                                 char *addr_string,
                                 char *excep_string,
+                                char *cond_string,
                                 const struct breakpoint_ops *ops,
                                 int tempflag,
                                 int from_tty)
@@ -11779,6 +11855,8 @@ create_ada_exception_catchpoint (struct gdbarch *gdbarch,
                                 ops, tempflag, from_tty);
   c->excep_string = excep_string;
   create_excep_cond_exprs (c);
+  if (cond_string != NULL)
+    set_breakpoint_condition (&c->base, cond_string, from_tty);
   install_breakpoint (0, &c->base, 1);
 }
 
@@ -11793,30 +11871,54 @@ catch_ada_exception_command (char *arg, int from_tty,
   struct symtab_and_line sal;
   char *addr_string = NULL;
   char *excep_string = NULL;
+  char *cond_string = NULL;
   const struct breakpoint_ops *ops = NULL;
 
   tempflag = get_cmd_context (command) == CATCH_TEMPORARY;
 
   if (!arg)
     arg = "";
-  sal = ada_decode_exception_location (arg, &addr_string, &excep_string, &ops);
+  sal = ada_decode_exception_location (arg, &addr_string, &excep_string,
+                                      &cond_string, &ops);
   create_ada_exception_catchpoint (gdbarch, sal, addr_string,
-                                  excep_string, ops, tempflag, from_tty);
+                                  excep_string, cond_string, ops,
+                                  tempflag, from_tty);
 }
 
+/* Assuming that ARGS contains the arguments of a "catch assert"
+   command, parse those arguments and return a symtab_and_line object
+   for a failed assertion catchpoint.
+
+   Set ADDR_STRING to the name of the function where the real
+   breakpoint that implements the catchpoint is set.
+
+   If ARGS contains a condition, set COND_STRING to that condition
+   (the memory needs to be deallocated after use).  Otherwise, set
+   COND_STRING to NULL.  */
+
 static struct symtab_and_line
 ada_decode_assert_location (char *args, char **addr_string,
+                           char **cond_string,
                             const struct breakpoint_ops **ops)
 {
-  /* Check that no argument where provided at the end of the command.  */
+  args = skip_spaces (args);
 
-  if (args != NULL)
+  /* Check whether a condition was provided.  */
+  if (strncmp (args, "if", 2) == 0
+      && (isspace (args[2]) || args[2] == '\0'))
     {
+      args += 2;
       args = skip_spaces (args);
-      if (*args != '\0')
-        error (_("Junk at end of arguments."));
+      if (args[0] == '\0')
+        error (_("condition missing after `if' keyword"));
+      *cond_string = xstrdup (args);
     }
 
+  /* Otherwise, there should be no other argument at the end of
+     the command.  */
+  else if (args[0] != '\0')
+    error (_("Junk at end of arguments."));
+
   return ada_exception_sal (ex_catch_assert, NULL, addr_string, ops);
 }
 
@@ -11830,15 +11932,17 @@ catch_assert_command (char *arg, int from_tty,
   int tempflag;
   struct symtab_and_line sal;
   char *addr_string = NULL;
+  char *cond_string = NULL;
   const struct breakpoint_ops *ops = NULL;
 
   tempflag = get_cmd_context (command) == CATCH_TEMPORARY;
 
   if (!arg)
     arg = "";
-  sal = ada_decode_assert_location (arg, &addr_string, &ops);
+  sal = ada_decode_assert_location (arg, &addr_string, &cond_string, &ops);
   create_ada_exception_catchpoint (gdbarch, sal, addr_string,
-                                  NULL, ops, tempflag, from_tty);
+                                  NULL, cond_string, ops, tempflag,
+                                  from_tty);
 }
                                 /* Operators */
 /* Information about operators given special treatment in functions
@@ -12321,11 +12425,11 @@ static const struct exp_descriptor ada_exp_descriptor = {
   ada_evaluate_subexp
 };
 
-/* Implement the "la_get_symbol_name_match_p" language_defn method
+/* Implement the "la_get_symbol_name_cmp" language_defn method
    for Ada.  */
 
-static symbol_name_match_p_ftype
-ada_get_symbol_name_match_p (const char *lookup_name)
+static symbol_name_cmp_ftype
+ada_get_symbol_name_cmp (const char *lookup_name)
 {
   if (should_use_wild_match (lookup_name))
     return wild_match;
@@ -12369,7 +12473,7 @@ const struct language_defn ada_language_defn = {
   ada_print_array_index,
   default_pass_by_reference,
   c_get_string,
-  ada_get_symbol_name_match_p, /* la_get_symbol_name_match_p */
+  ada_get_symbol_name_cmp,     /* la_get_symbol_name_cmp */
   ada_iterate_over_symbols,
   LANG_MAGIC
 };
This page took 0.042479 seconds and 4 git commands to generate.