[commit/Ada] Add support for new renaming scheme

Joel Brobecker brobecker@adacore.com
Fri Dec 21 13:20:00 GMT 2007


Hello,

A few months ago, we changed the encoding related to renamings. For
every object, we used to have to lookup a parallel ___XR *type*, but
that encoding didn't work well, particularly inside anonymous blocks.

So we changed the encoding as follow:

   --  All other cases of renaming generate a dummy variable for an entity
   --  whose name is of the form:

   --    x___XR_...    for an object renaming
   --    x___XRE_...   for an exception renaming
   --    x___XRP_...   for a package renaming

   --  and where the "..." represents a suffix that describes the structure of
   --  the object name given in the renaming (see details below).

The part in the encoding that describes the renaming is unchanged.
Here is an example of the new encoding in action:

   --      As an example, consider the declarations:

   --        package p is
   --           type q is record
   --              m : string (2 .. 5);
   --           end record;
   --
   --           type r is array (1 .. 10, 1 .. 20) of q;
   --
   --           g : r;
   --
   --           z : string renames g (1,5).m(2 ..3)
   --        end p;

   --     The generated variable entity would appear as

   --       p__z___XR_p__g___XEXS1XS5XRmXL2XS3 : _renaming_type;
   --                 p__g___XE--------------------outer entity is g
   --                          XS1-----------------first subscript for g
   --                             XS5--------------second subscript for g
   --                                XRm-----------select field m
   --                                   XL2--------lower bound of slice
   --                                      XS3-----upper bound of slice

The attached patch implements support for the new encoding, while
falling back to the previous encoding if the old one is still in use.
So we should stay compatible with both encodings.

Eventually, it would be very nice to rely on pure DWARF to encode
that information and get rid of the encoding, but this is a general
project on which we haven't made much progress yet. Also, we are
still supporting some platforms where DWARF is not available.

2007-12-21  Paul N. Hilfinger  <hilfinger@adacore.com>

        * ada-lang.h (ada_renaming_category): New enumerated type.
        (ada_lookup_encoded_symbol): Declare.
        (ada_parse_renaming): Declare.
        (ada_renaming_type,ada_is_object_renaming)
        (ada_simple_renamed_entity): Delete declarations.
        * ada-lang.c (ada_parse_renaming): New function to concentrate
        extraction of information from renaming symbols.
        (parse_old_style_renaming): New function to concentrate
        extraction of old-style (purely type-based) renaming information.
        (renaming_is_visible): Rename to...
        (old_renaming_is_invisible): Rename and change sense of
        renaming_is_visible.
        (remove_out_of_scope_renamings): Rename to...
        (remove_irrelevant_renamings): Renames remove_out_of_scope_renamings
        and augments with additional logic to handle cases where the same
        object renaming is encoded both as a reference variable and an
        encoded renaming.
        (ada_renaming_type,ada_is_object_renaming)
        (ada_simple_renamed_entity): Delete definitions.
        (ada_lookup_encoded_symbol): New function factored out of
        ada_lookup_symbol.
        (ada_lookup_symbol): Reimplement to call ada_lookup_encoded_symbol.
        (wild_match): Don't reject perfect match of prefix.
        (ada_find_renaming_symbol): Factor old-style renaming logic into
        find_old_style_renaming_symbol.
        (find_old_style_renaming_symbol): New name for content of old
        ada_find_renaming_symbol.
        (ada_prefer_type): Reimplement not to use ada_renaming_type.
        * ada-exp.y (write_object_renaming): Change interface.  Reimplement
        to use new arguments and ada_parse_renaming.
        Correct blocks used to find array index.
        (write_var_or_type): Reimplement to use ada_parse_renaming.

Tested on x86-linux. Fixes some timeouts in arrayidx.exp.
Checked in.

-- 
Joel
-------------- next part --------------
Index: ada-lang.h
===================================================================
RCS file: /cvs/src/src/gdb/ada-lang.h,v
retrieving revision 1.27
diff -u -p -r1.27 ada-lang.h
--- ada-lang.h	23 Aug 2007 18:08:25 -0000	1.27
+++ ada-lang.h	21 Dec 2007 10:50:22 -0000
@@ -173,6 +173,28 @@ struct ada_symbol_info {
   struct symtab* symtab;
 };
 
+/* Denotes a type of renaming symbol (see ada_parse_renaming).  */
+enum ada_renaming_category
+  {
+    /* Indicates a symbol that does not encode a renaming.  */
+    ADA_NOT_RENAMING,
+
+    /* For symbols declared
+         Foo : TYPE renamed OBJECT;  */
+    ADA_OBJECT_RENAMING,
+
+    /* For symbols declared
+         Foo : exception renames EXCEPTION;  */
+    ADA_EXCEPTION_RENAMING,
+    /* For packages declared
+          package Foo renames PACKAGE; */
+    ADA_PACKAGE_RENAMING,
+    /* For subprograms declared
+          SUBPROGRAM_SPEC renames SUBPROGRAM;
+       (Currently not used).  */
+    ADA_SUBPROGRAM_RENAMING
+  };
+
 /* Ada task structures.  */
 
 /* Ada task control block, as defined in the GNAT runt-time library.  */
@@ -301,6 +323,11 @@ extern struct symbol *ada_lookup_symbol 
                                          domain_enum, int *, 
 					 struct symtab **);
 
+extern struct symbol *
+ada_lookup_encoded_symbol (const char *, const struct block *,
+			   domain_enum namespace, 
+			   struct block **, struct symtab **);
+
 extern struct minimal_symbol *ada_lookup_simple_minsym (const char *);
 
 extern void ada_fill_in_ada_prototype (struct symbol *);
@@ -438,11 +465,9 @@ extern void ada_print_scalar (struct typ
 
 extern int ada_is_range_type_name (const char *);
 
-extern const char *ada_renaming_type (struct type *);
-
-extern int ada_is_object_renaming (struct symbol *);
-
-extern char *ada_simple_renamed_entity (struct symbol *);
+extern enum ada_renaming_category ada_parse_renaming (struct symbol *,
+						      const char **,
+						      int *, const char **);
 
 extern char *ada_breakpoint_rewrite (char *, int *);
 
Index: ada-lang.c
===================================================================
RCS file: /cvs/src/src/gdb/ada-lang.c,v
retrieving revision 1.109
diff -u -p -r1.109 ada-lang.c
--- ada-lang.c	4 Dec 2007 23:33:00 -0000	1.109
+++ ada-lang.c	21 Dec 2007 10:51:00 -0000
@@ -153,6 +153,14 @@ static int scalar_type_p (struct type *)
 
 static int discrete_type_p (struct type *);
 
+static enum ada_renaming_category parse_old_style_renaming (struct type *,
+							    const char **,
+							    int *,
+							    const char **);
+
+static struct symbol *find_old_style_renaming_symbol (const char *,
+						      struct block *);
+
 static struct type *ada_lookup_struct_elt_type (struct type *, char *,
                                                 int, int, int *);
 
@@ -3547,68 +3555,156 @@ possible_user_operator_p (enum exp_opcod
 
                                 /* Renaming */
 
-/* NOTE: In the following, we assume that a renaming type's name may
-   have an ___XD suffix.  It would be nice if this went away at some
-   point.  */
-
-/* If TYPE encodes a renaming, returns the renaming suffix, which
-   is XR for an object renaming, XRP for a procedure renaming, XRE for
-   an exception renaming, and XRS for a subprogram renaming.  Returns
-   NULL if NAME encodes none of these.  */
+/* NOTES: 
 
-const char *
-ada_renaming_type (struct type *type)
-{
-  if (type != NULL && TYPE_CODE (type) == TYPE_CODE_ENUM)
+   1. In the following, we assume that a renaming type's name may
+      have an ___XD suffix.  It would be nice if this went away at some
+      point.
+   2. We handle both the (old) purely type-based representation of 
+      renamings and the (new) variable-based encoding.  At some point,
+      it is devoutly to be hoped that the former goes away 
+      (FIXME: hilfinger-2007-07-09).
+   3. Subprogram renamings are not implemented, although the XRS
+      suffix is recognized (FIXME: hilfinger-2007-07-09).  */
+
+/* If SYM encodes a renaming, 
+
+       <renaming> renames <renamed entity>,
+
+   sets *LEN to the length of the renamed entity's name,
+   *RENAMED_ENTITY to that name (not null-terminated), and *RENAMING_EXPR to
+   the string describing the subcomponent selected from the renamed
+   entity. Returns ADA_NOT_RENAMING if SYM does not encode a renaming
+   (in which case, the values of *RENAMED_ENTITY, *LEN, and *RENAMING_EXPR
+   are undefined).  Otherwise, returns a value indicating the category
+   of entity renamed: an object (ADA_OBJECT_RENAMING), exception
+   (ADA_EXCEPTION_RENAMING), package (ADA_PACKAGE_RENAMING), or
+   subprogram (ADA_SUBPROGRAM_RENAMING).  Does no allocation; the
+   strings returned in *RENAMED_ENTITY and *RENAMING_EXPR should not be
+   deallocated.  The values of RENAMED_ENTITY, LEN, or RENAMING_EXPR
+   may be NULL, in which case they are not assigned.
+
+   [Currently, however, GCC does not generate subprogram renamings.]  */
+
+enum ada_renaming_category
+ada_parse_renaming (struct symbol *sym,
+		    const char **renamed_entity, int *len, 
+		    const char **renaming_expr)
+{
+  enum ada_renaming_category kind;
+  const char *info;
+  const char *suffix;
+
+  if (sym == NULL)
+    return ADA_NOT_RENAMING;
+  switch (SYMBOL_CLASS (sym)) 
     {
-      const char *name = type_name_no_tag (type);
-      const char *suffix = (name == NULL) ? NULL : strstr (name, "___XR");
-      if (suffix == NULL
-          || (suffix[5] != '\000' && strchr ("PES_", suffix[5]) == NULL))
-        return NULL;
-      else
-        return suffix + 3;
+    default:
+      return ADA_NOT_RENAMING;
+    case LOC_TYPEDEF:
+      return parse_old_style_renaming (SYMBOL_TYPE (sym), 
+				       renamed_entity, len, renaming_expr);
+    case LOC_LOCAL:
+    case LOC_STATIC:
+    case LOC_COMPUTED:
+    case LOC_OPTIMIZED_OUT:
+      info = strstr (SYMBOL_LINKAGE_NAME (sym), "___XR");
+      if (info == NULL)
+	return ADA_NOT_RENAMING;
+      switch (info[5])
+	{
+	case '_':
+	  kind = ADA_OBJECT_RENAMING;
+	  info += 6;
+	  break;
+	case 'E':
+	  kind = ADA_EXCEPTION_RENAMING;
+	  info += 7;
+	  break;
+	case 'P':
+	  kind = ADA_PACKAGE_RENAMING;
+	  info += 7;
+	  break;
+	case 'S':
+	  kind = ADA_SUBPROGRAM_RENAMING;
+	  info += 7;
+	  break;
+	default:
+	  return ADA_NOT_RENAMING;
+	}
     }
-  else
-    return NULL;
-}
-
-/* Return non-zero iff SYM encodes an object renaming.  */
 
-int
-ada_is_object_renaming (struct symbol *sym)
+  if (renamed_entity != NULL)
+    *renamed_entity = info;
+  suffix = strstr (info, "___XE");
+  if (suffix == NULL || suffix == info)
+    return ADA_NOT_RENAMING;
+  if (len != NULL)
+    *len = strlen (info) - strlen (suffix);
+  suffix += 5;
+  if (renaming_expr != NULL)
+    *renaming_expr = suffix;
+  return kind;
+}
+
+/* Assuming TYPE encodes a renaming according to the old encoding in
+   exp_dbug.ads, returns details of that renaming in *RENAMED_ENTITY,
+   *LEN, and *RENAMING_EXPR, as for ada_parse_renaming, above.  Returns
+   ADA_NOT_RENAMING otherwise.  */
+static enum ada_renaming_category
+parse_old_style_renaming (struct type *type,
+			  const char **renamed_entity, int *len, 
+			  const char **renaming_expr)
 {
-  const char *renaming_type = ada_renaming_type (SYMBOL_TYPE (sym));
-  return renaming_type != NULL
-    && (renaming_type[2] == '\0' || renaming_type[2] == '_');
-}
+  enum ada_renaming_category kind;
+  const char *name;
+  const char *info;
+  const char *suffix;
 
-/* Assuming that SYM encodes a non-object renaming, returns the original
-   name of the renamed entity.  The name is good until the end of
-   parsing.  */
+  if (type == NULL || TYPE_CODE (type) != TYPE_CODE_ENUM 
+      || TYPE_NFIELDS (type) != 1)
+    return ADA_NOT_RENAMING;
 
-char *
-ada_simple_renamed_entity (struct symbol *sym)
-{
-  struct type *type;
-  const char *raw_name;
-  int len;
-  char *result;
+  name = type_name_no_tag (type);
+  if (name == NULL)
+    return ADA_NOT_RENAMING;
+  
+  name = strstr (name, "___XR");
+  if (name == NULL)
+    return ADA_NOT_RENAMING;
+  switch (name[5])
+    {
+    case '\0':
+    case '_':
+      kind = ADA_OBJECT_RENAMING;
+      break;
+    case 'E':
+      kind = ADA_EXCEPTION_RENAMING;
+      break;
+    case 'P':
+      kind = ADA_PACKAGE_RENAMING;
+      break;
+    case 'S':
+      kind = ADA_SUBPROGRAM_RENAMING;
+      break;
+    default:
+      return ADA_NOT_RENAMING;
+    }
 
-  type = SYMBOL_TYPE (sym);
-  if (type == NULL || TYPE_NFIELDS (type) < 1)
-    error (_("Improperly encoded renaming."));
-
-  raw_name = TYPE_FIELD_NAME (type, 0);
-  len = (raw_name == NULL ? 0 : strlen (raw_name)) - 5;
-  if (len <= 0)
-    error (_("Improperly encoded renaming."));
-
-  result = xmalloc (len + 1);
-  strncpy (result, raw_name, len);
-  result[len] = '\000';
-  return result;
-}
+  info = TYPE_FIELD_NAME (type, 0);
+  if (info == NULL)
+    return ADA_NOT_RENAMING;
+  if (renamed_entity != NULL)
+    *renamed_entity = info;
+  suffix = strstr (info, "___XE");
+  if (renaming_expr != NULL)
+    *renaming_expr = suffix + 5;
+  if (suffix == NULL || suffix == info)
+    return ADA_NOT_RENAMING;
+  if (len != NULL)
+    *len = suffix - info;
+  return kind;
+}  
 
 
 
@@ -4315,18 +4411,23 @@ is_package_name (const char *name)
 }
 
 /* Return nonzero if SYM corresponds to a renaming entity that is
-   visible from FUNCTION_NAME.  */
+   not visible from FUNCTION_NAME.  */
 
 static int
-renaming_is_visible (const struct symbol *sym, char *function_name)
+old_renaming_is_invisible (const struct symbol *sym, char *function_name)
 {
-  char *scope = xget_renaming_scope (SYMBOL_TYPE (sym));
+  char *scope;
+
+  if (SYMBOL_CLASS (sym) != LOC_TYPEDEF)
+    return 0;
+
+  scope = xget_renaming_scope (SYMBOL_TYPE (sym));
 
   make_cleanup (xfree, scope);
 
   /* If the rename has been defined in a package, then it is visible.  */
   if (is_package_name (scope))
-    return 1;
+    return 0;
 
   /* Check that the rename is in the current function scope by checking
      that its name starts with SCOPE.  */
@@ -4338,15 +4439,22 @@ renaming_is_visible (const struct symbol
   if (strncmp (function_name, "_ada_", 5) == 0)
     function_name += 5;
 
-  return (strncmp (function_name, scope, strlen (scope)) == 0);
+  return (strncmp (function_name, scope, strlen (scope)) != 0);
 }
 
-/* Iterates over the SYMS list and remove any entry that corresponds to
-   a renaming entity that is not visible from the function associated
-   with CURRENT_BLOCK. 
+/* Remove entries from SYMS that corresponds to a renaming entity that
+   is not visible from the function associated with CURRENT_BLOCK or
+   that is superfluous due to the presence of more specific renaming
+   information.  Places surviving symbols in the initial entries of
+   SYMS and returns the number of surviving symbols.
    
    Rationale:
-   GNAT emits a type following a specified encoding for each renaming
+   First, in cases where an object renaming is implemented as a
+   reference variable, GNAT may produce both the actual reference
+   variable and the renaming encoding.  In this case, we discard the
+   latter.
+
+   Second, GNAT emits a type following a specified encoding for each renaming
    entity.  Unfortunately, STABS currently does not support the definition
    of types that are local to a given lexical block, so all renamings types
    are emitted at library level.  As a consequence, if an application
@@ -4372,12 +4480,55 @@ renaming_is_visible (const struct symbol
         the user will be unable to print such rename entities.  */
 
 static int
-remove_out_of_scope_renamings (struct ada_symbol_info *syms,
-                               int nsyms, const struct block *current_block)
+remove_irrelevant_renamings (struct ada_symbol_info *syms,
+			     int nsyms, const struct block *current_block)
 {
   struct symbol *current_function;
   char *current_function_name;
   int i;
+  int is_new_style_renaming;
+
+  /* If there is both a renaming foo___XR... encoded as a variable and
+     a simple variable foo in the same block, discard the latter.
+     First, zero out such symbols, then compress. */
+  is_new_style_renaming = 0;
+  for (i = 0; i < nsyms; i += 1)
+    {
+      struct symbol *sym = syms[i].sym;
+      struct block *block = syms[i].block;
+      const char *name;
+      const char *suffix;
+
+      if (sym == NULL || SYMBOL_CLASS (sym) == LOC_TYPEDEF)
+	continue;
+      name = SYMBOL_LINKAGE_NAME (sym);
+      suffix = strstr (name, "___XR");
+
+      if (suffix != NULL)
+	{
+	  int name_len = suffix - name;
+	  int j;
+	  is_new_style_renaming = 1;
+	  for (j = 0; j < nsyms; j += 1)
+	    if (i != j && syms[j].sym != NULL
+		&& strncmp (name, SYMBOL_LINKAGE_NAME (syms[j].sym),
+			    name_len) == 0
+		&& block == syms[j].block)
+	      syms[j].sym = NULL;
+	}
+    }
+  if (is_new_style_renaming)
+    {
+      int j, k;
+
+      for (j = k = 0; j < nsyms; j += 1)
+	if (syms[j].sym != NULL)
+	    {
+	      syms[k] = syms[j];
+	      k += 1;
+	    }
+      return k;
+    }
 
   /* Extract the function name associated to CURRENT_BLOCK.
      Abort if unable to do so.  */
@@ -4400,11 +4551,12 @@ remove_out_of_scope_renamings (struct ad
   i = 0;
   while (i < nsyms)
     {
-      if (ada_is_object_renaming (syms[i].sym)
-          && !renaming_is_visible (syms[i].sym, current_function_name))
+      if (ada_parse_renaming (syms[i].sym, NULL, NULL, NULL)
+          == ADA_OBJECT_RENAMING
+          && old_renaming_is_invisible (syms[i].sym, current_function_name))
         {
           int j;
-          for (j = i + 1; j < nsyms; j++)
+          for (j = i + 1; j < nsyms; j += 1)
             syms[j - 1] = syms[j];
           nsyms -= 1;
         }
@@ -4610,35 +4762,26 @@ done:
     cache_symbol (name0, namespace, (*results)[0].sym, (*results)[0].block,
                   (*results)[0].symtab);
 
-  ndefns = remove_out_of_scope_renamings (*results, ndefns, block0);
+  ndefns = remove_irrelevant_renamings (*results, ndefns, block0);
 
   return ndefns;
 }
 
-/* Return a symbol in DOMAIN matching NAME, in BLOCK0 and enclosing
-   scope and in global scopes, or NULL if none.  NAME is folded and
-   encoded first.  Otherwise, the result is as for ada_lookup_symbol_list,
-   choosing the first symbol if there are multiple choices.  
-   *IS_A_FIELD_OF_THIS is set to 0 and *SYMTAB is set to the symbol
-   table in which the symbol was found (in both cases, these
-   assignments occur only if the pointers are non-null).  */
-
 struct symbol *
-ada_lookup_symbol (const char *name, const struct block *block0,
-                   domain_enum namespace, int *is_a_field_of_this,
-                   struct symtab **symtab)
+ada_lookup_encoded_symbol (const char *name, const struct block *block0,
+			   domain_enum namespace, 
+			   struct block **block_found, struct symtab **symtab)
 {
   struct ada_symbol_info *candidates;
   int n_candidates;
 
-  n_candidates = ada_lookup_symbol_list (ada_encode (ada_fold_name (name)),
-                                         block0, namespace, &candidates);
+  n_candidates = ada_lookup_symbol_list (name, block0, namespace, &candidates);
 
   if (n_candidates == 0)
     return NULL;
 
-  if (is_a_field_of_this != NULL)
-    *is_a_field_of_this = 0;
+  if (block_found != NULL)
+    *block_found = candidates[0].block;
 
   if (symtab != NULL)
     {
@@ -4674,6 +4817,26 @@ ada_lookup_symbol (const char *name, con
         }
     }
   return candidates[0].sym;
+}  
+
+/* Return a symbol in DOMAIN matching NAME, in BLOCK0 and enclosing
+   scope and in global scopes, or NULL if none.  NAME is folded and
+   encoded first.  Otherwise, the result is as for ada_lookup_symbol_list,
+   choosing the first symbol if there are multiple choices.  
+   *IS_A_FIELD_OF_THIS is set to 0 and *SYMTAB is set to the symbol
+   table in which the symbol was found (in both cases, these
+   assignments occur only if the pointers are non-null).  */
+struct symbol *
+ada_lookup_symbol (const char *name, const struct block *block0,
+                   domain_enum namespace, int *is_a_field_of_this,
+                   struct symtab **symtab)
+{
+  if (is_a_field_of_this != NULL)
+    *is_a_field_of_this = 0;
+
+  return
+    ada_lookup_encoded_symbol (ada_encode (ada_fold_name (name)),
+			       block0, namespace, NULL, symtab);
 }
 
 static struct symbol *
@@ -4847,10 +5010,8 @@ is_dot_digits_suffix (const char *str)
   return (str[0] == '\0');
 }
 
-/* Return non-zero if NAME0 is a valid match when doing wild matching.
-   Certain symbols appear at first to match, except that they turn out
-   not to follow the Ada encoding and hence should not be used as a wild
-   match of a given pattern.  */
+/* Return non-zero if the string starting at NAME and ending before
+   NAME_END contains no capital letters.  */
 
 static int
 is_valid_name_for_wild_match (const char *name0)
@@ -4875,6 +5036,7 @@ wild_match (const char *patn0, int patn_
 {
   int name_len;
   char *name;
+  char *name_start;
   char *patn;
 
   /* FIXME: brobecker/2003-11-10: For some reason, the symbol name
@@ -4901,7 +5063,7 @@ wild_match (const char *patn0, int patn_
     char *dot;
     name_len = strlen (name0);
 
-    name = (char *) alloca ((name_len + 1) * sizeof (char));
+    name = name_start = (char *) alloca ((name_len + 1) * sizeof (char));
     strcpy (name, name0);
     dot = strrchr (name, '.');
     if (dot != NULL && is_dot_digits_suffix (dot))
@@ -4930,7 +5092,7 @@ wild_match (const char *patn0, int patn_
     {
       if (strncmp (patn, name, patn_len) == 0
           && is_name_suffix (name + patn_len))
-        return (is_valid_name_for_wild_match (name0));
+        return (name == name_start || is_valid_name_for_wild_match (name0));
       do
         {
           name += 1;
@@ -6161,14 +6323,32 @@ ada_find_any_type (const char *name)
   return NULL;
 }
 
-/* Given a symbol NAME and its associated BLOCK, search all symbols
-   for its ___XR counterpart, which is the ``renaming'' symbol
+/* 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.  */
 
 struct symbol *
 ada_find_renaming_symbol (const char *name, struct block *block)
 {
+  struct symbol *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);
+  if (sym != NULL && strstr (SYMBOL_LINKAGE_NAME (sym), "___XR") != NULL)
+    return sym;
+  else
+    return NULL;
+}
+
+static struct symbol *
+find_old_style_renaming_symbol (const char *name, struct block *block)
+{
   const struct symbol *function_sym = block_function (block);
   char *rename;
 
@@ -6193,7 +6373,7 @@ ada_find_renaming_symbol (const char *na
 
       /* Library-level functions are a special case, as GNAT adds
          a ``_ada_'' prefix to the function name to avoid namespace
-         pollution.  However, the renaming symbol themselves do not
+         pollution.  However, the renaming symbols themselves do not
          have this prefix, so we need to skip this prefix if present.  */
       if (function_name_len > 5 /* "_ada_" */
           && strstr (function_name, "_ada_") == function_name)
@@ -6235,9 +6415,15 @@ ada_prefer_type (struct type *type0, str
   else if (ada_is_array_descriptor_type (type0)
            && !ada_is_array_descriptor_type (type1))
     return 1;
-  else if (ada_renaming_type (type0) != NULL
-           && ada_renaming_type (type1) == NULL)
-    return 1;
+  else
+    {
+      const char *type0_name = type_name_no_tag (type0);
+      const char *type1_name = type_name_no_tag (type1);
+
+      if (type0_name != NULL && strstr (type0_name, "___XR") != NULL
+	  && (type1_name == NULL || strstr (type1_name, "___XR") == NULL))
+	return 1;
+    }
   return 0;
 }
 
Index: ada-exp.y
===================================================================
RCS file: /cvs/src/src/gdb/ada-exp.y,v
retrieving revision 1.20
diff -u -p -r1.20 ada-exp.y
--- ada-exp.y	9 Jan 2007 17:58:49 -0000	1.20
+++ ada-exp.y	21 Dec 2007 10:51:03 -0000
@@ -124,7 +124,8 @@ static struct stoken string_to_operator 
 
 static void write_int (LONGEST, struct type *);
 
-static void write_object_renaming (struct block *, struct symbol *, int);
+static void write_object_renaming (struct block *, const char *, int,
+				   const char *, int);
 
 static struct type* write_var_or_type (struct block *, struct stoken);
 
@@ -839,82 +840,86 @@ write_exp_op_with_string (enum exp_opcod
   write_exp_elt_opcode (opcode);
 }
   
-/* Emit expression corresponding to the renamed object designated by
- * the type RENAMING, which must be the referent of an object renaming
- * type, in the context of ORIG_LEFT_CONTEXT.  MAX_DEPTH is the maximum
- * number of cascaded renamings to allow.  */
+/* Emit expression corresponding to the renamed object named 
+ * designated by RENAMED_ENTITY[0 .. RENAMED_ENTITY_LEN-1] in the
+ * context of ORIG_LEFT_CONTEXT, to which is applied the operations
+ * encoded by RENAMING_EXPR.  MAX_DEPTH is the maximum number of
+ * cascaded renamings to allow.  If ORIG_LEFT_CONTEXT is null, it
+ * defaults to the currently selected block. ORIG_SYMBOL is the 
+ * symbol that originally encoded the renaming.  It is needed only
+ * because its prefix also qualifies any index variables used to index
+ * or slice an array.  It should not be necessary once we go to the
+ * new encoding entirely (FIXME pnh 7/20/2007).  */
+
 static void
-write_object_renaming (struct block *orig_left_context, 
-		       struct symbol *renaming, int max_depth)
+write_object_renaming (struct block *orig_left_context,
+		       const char *renamed_entity, int renamed_entity_len,
+		       const char *renaming_expr, int max_depth)
 {
-  const char *qualification = SYMBOL_LINKAGE_NAME (renaming);
-  const char *simple_tail;
-  const char *expr = TYPE_FIELD_NAME (SYMBOL_TYPE (renaming), 0);
-  const char *suffix;
   char *name;
-  struct symbol *sym;
   enum { SIMPLE_INDEX, LOWER_BOUND, UPPER_BOUND } slice_state;
+  struct symbol *sym;
+  struct block *block;
 
   if (max_depth <= 0)
     error (_("Could not find renamed symbol"));
 
-  /* if orig_left_context is null, then use the currently selected
-     block; otherwise we might fail our symbol lookup below.  */
   if (orig_left_context == NULL)
     orig_left_context = get_selected_block (NULL);
 
-  for (simple_tail = qualification + strlen (qualification);
-       simple_tail != qualification; simple_tail -= 1)
-    {
-      if (*simple_tail == '.')
-	{
-	  simple_tail += 1;
-	  break;
-	}
-      else if (strncmp (simple_tail, "__", 2) == 0)
-	{
-	  simple_tail += 2;
-	  break;
-	}
-    }
-
-  suffix = strstr (expr, "___XE");
-  if (suffix == NULL)
-    goto BadEncoding;
-
-  name = (char *) obstack_alloc (&temp_parse_space, suffix - expr + 1);
-  strncpy (name, expr, suffix-expr);
-  name[suffix-expr] = '\000';
-  sym = lookup_symbol (name, orig_left_context, VAR_DOMAIN, 0, NULL);
+  name = obsavestring (renamed_entity, renamed_entity_len, &temp_parse_space);
+  sym = ada_lookup_encoded_symbol (name, orig_left_context, VAR_DOMAIN, 
+				   &block, NULL);
   if (sym == NULL)
     error (_("Could not find renamed variable: %s"), ada_decode (name));
-  if (ada_is_object_renaming (sym))
-    write_object_renaming (orig_left_context, sym, max_depth-1);
-  else
-    write_var_from_sym (orig_left_context, block_found, sym);
+  else if (SYMBOL_CLASS (sym) == LOC_TYPEDEF)
+    /* We have a renaming of an old-style renaming symbol.  Don't
+       trust the block information.  */
+    block = orig_left_context;
+
+  {
+    const char *inner_renamed_entity;
+    int inner_renamed_entity_len;
+    const char *inner_renaming_expr;
+
+    switch (ada_parse_renaming (sym, &inner_renamed_entity, 
+				&inner_renamed_entity_len,
+				&inner_renaming_expr))
+      {
+      case ADA_NOT_RENAMING:
+	write_var_from_sym (orig_left_context, block, sym);
+	break;
+      case ADA_OBJECT_RENAMING:
+	write_object_renaming (block,
+			       inner_renamed_entity, inner_renamed_entity_len,
+			       inner_renaming_expr, max_depth - 1);
+	break;
+      default:
+	goto BadEncoding;
+      }
+  }
 
-  suffix += 5;
   slice_state = SIMPLE_INDEX;
-  while (*suffix == 'X')
+  while (*renaming_expr == 'X')
     {
-      suffix += 1;
+      renaming_expr += 1;
 
-      switch (*suffix) {
+      switch (*renaming_expr) {
       case 'A':
-        suffix += 1;
+        renaming_expr += 1;
         write_exp_elt_opcode (UNOP_IND);
         break;
       case 'L':
 	slice_state = LOWER_BOUND;
       case 'S':
-	suffix += 1;
-	if (isdigit (*suffix))
+	renaming_expr += 1;
+	if (isdigit (*renaming_expr))
 	  {
 	    char *next;
-	    long val = strtol (suffix, &next, 10);
-	    if (next == suffix)
+	    long val = strtol (renaming_expr, &next, 10);
+	    if (next == renaming_expr)
 	      goto BadEncoding;
-	    suffix = next;
+	    renaming_expr = next;
 	    write_exp_elt_opcode (OP_LONG);
 	    write_exp_elt_type (type_int ());
 	    write_exp_elt_longcst ((LONGEST) val);
@@ -924,27 +929,26 @@ write_object_renaming (struct block *ori
 	  {
 	    const char *end;
 	    char *index_name;
-	    int index_len;
 	    struct symbol *index_sym;
 
-	    end = strchr (suffix, 'X');
+	    end = strchr (renaming_expr, 'X');
 	    if (end == NULL)
-	      end = suffix + strlen (suffix);
+	      end = renaming_expr + strlen (renaming_expr);
 
-	    index_len = simple_tail - qualification + 2 + (suffix - end) + 1;
-	    index_name
-	      = (char *) obstack_alloc (&temp_parse_space, index_len);
-	    memset (index_name, '\000', index_len);
-	    strncpy (index_name, qualification, simple_tail - qualification);
-	    index_name[simple_tail - qualification] = '\000';
-	    strncat (index_name, suffix, suffix-end);
-	    suffix = end;
-
-	    index_sym =
-	      lookup_symbol (index_name, NULL, VAR_DOMAIN, 0, NULL);
+	    index_name =
+	      obsavestring (renaming_expr, end - renaming_expr,
+			    &temp_parse_space);
+	    renaming_expr = end;
+
+	    index_sym = ada_lookup_encoded_symbol (index_name, NULL,
+						   VAR_DOMAIN, &block,
+						   NULL);
 	    if (index_sym == NULL)
 	      error (_("Could not find %s"), index_name);
-	    write_var_from_sym (NULL, block_found, sym);
+	    else if (SYMBOL_CLASS (index_sym) == LOC_TYPEDEF)
+	      /* Index is an old-style renaming symbol.  */
+	      block = orig_left_context;
+	    write_var_from_sym (NULL, block, index_sym);
 	  }
 	if (slice_state == SIMPLE_INDEX)
 	  {
@@ -965,18 +969,18 @@ write_object_renaming (struct block *ori
 	{
 	  struct stoken field_name;
 	  const char *end;
-	  suffix += 1;
+	  renaming_expr += 1;
 
 	  if (slice_state != SIMPLE_INDEX)
 	    goto BadEncoding;
-	  end = strchr (suffix, 'X');
+	  end = strchr (renaming_expr, 'X');
 	  if (end == NULL)
-	    end = suffix + strlen (suffix);
-	  field_name.length = end - suffix;
-	  field_name.ptr = xmalloc (end - suffix + 1);
-	  strncpy (field_name.ptr, suffix, end - suffix);
-	  field_name.ptr[end - suffix] = '\000';
-	  suffix = end;
+	    end = renaming_expr + strlen (renaming_expr);
+	  field_name.length = end - renaming_expr;
+	  field_name.ptr = xmalloc (end - renaming_expr + 1);
+	  strncpy (field_name.ptr, renaming_expr, end - renaming_expr);
+	  field_name.ptr[end - renaming_expr] = '\000';
+	  renaming_expr = end;
 	  write_exp_op_with_string (STRUCTOP_STRUCT, field_name);
 	  break;
 	}
@@ -989,8 +993,7 @@ write_object_renaming (struct block *ori
     return;
 
  BadEncoding:
-  error (_("Internal error in encoding of renaming declaration: %s"),
-	 SYMBOL_LINKAGE_NAME (renaming));
+  error (_("Internal error in encoding of renaming declaration"));
 }
 
 static struct block*
@@ -1185,6 +1188,10 @@ write_var_or_type (struct block *block, 
 	  int nsyms;
 	  struct ada_symbol_info *syms;
 	  struct symbol *type_sym;
+	  struct symbol *renaming_sym;
+	  const char* renaming;
+	  int renaming_len;
+	  const char* renaming_expr;
 	  int terminator = encoded_name[tail_index];
 
 	  encoded_name[tail_index] = '\0';
@@ -1194,47 +1201,61 @@ write_var_or_type (struct block *block, 
 
 	  /* A single symbol may rename a package or object. */
 
-	  if (nsyms == 1 && !ada_is_object_renaming (syms[0].sym))
+	  /* This should go away when we move entirely to new version.
+	     FIXME pnh 7/20/2007. */
+	  if (nsyms == 1)
 	    {
-	      struct symbol *renaming_sym =
+	      struct symbol *renaming =
 		ada_find_renaming_symbol (SYMBOL_LINKAGE_NAME (syms[0].sym), 
 					  syms[0].block);
 
-	      if (renaming_sym != NULL)
-		syms[0].sym = renaming_sym;
+	      if (renaming != NULL)
+		syms[0].sym = renaming;
 	    }
 
 	  type_sym = select_possible_type_sym (syms, nsyms);
+
+	  if (type_sym != NULL)
+	    renaming_sym = type_sym;
+	  else if (nsyms == 1)
+	    renaming_sym = syms[0].sym;
+	  else 
+	    renaming_sym = NULL;
+
+	  switch (ada_parse_renaming (renaming_sym, &renaming,
+				      &renaming_len, &renaming_expr))
+	    {
+	    case ADA_NOT_RENAMING:
+	      break;
+	    case ADA_PACKAGE_RENAMING:
+	    case ADA_EXCEPTION_RENAMING:
+	    case ADA_SUBPROGRAM_RENAMING:
+	      {
+		char *new_name
+		  = obstack_alloc (&temp_parse_space,
+				   renaming_len + name_len - tail_index + 1);
+		strncpy (new_name, renaming, renaming_len);
+		strcpy (new_name + renaming_len, encoded_name + tail_index);
+		encoded_name = new_name;
+		name_len = renaming_len + name_len - tail_index;
+		goto TryAfterRenaming;
+	      }	
+	    case ADA_OBJECT_RENAMING:
+	      write_object_renaming (block, renaming, renaming_len, 
+				     renaming_expr, MAX_RENAMING_CHAIN_LENGTH);
+	      write_selectors (encoded_name + tail_index);
+	      return NULL;
+	    default:
+	      internal_error (__FILE__, __LINE__,
+			      _("impossible value from ada_parse_renaming"));
+	    }
+
 	  if (type_sym != NULL)
 	    {
 	      struct type *type = SYMBOL_TYPE (type_sym);
 
 	      if (TYPE_CODE (type) == TYPE_CODE_VOID)
 		error (_("`%s' matches only void type name(s)"), name0.ptr);
-	      else if (ada_is_object_renaming (type_sym))
-		{
-		  write_object_renaming (block, type_sym, 
-					 MAX_RENAMING_CHAIN_LENGTH);
-		  write_selectors (encoded_name + tail_index);
-		  return NULL;
-		}
-	      else if (ada_renaming_type (SYMBOL_TYPE (type_sym)) != NULL)
-		{
-		  int result;
-		  char *renaming = ada_simple_renamed_entity (type_sym);
-		  int renaming_len = strlen (renaming);
-
-		  char *new_name
-		    = obstack_alloc (&temp_parse_space,
-				     renaming_len + name_len - tail_index 
-				     + 1);
-		  strcpy (new_name, renaming);
-		  xfree (renaming);
-		  strcpy (new_name + renaming_len, encoded_name + tail_index);
-		  encoded_name = new_name;
-		  name_len = renaming_len + name_len - tail_index;
-		  goto TryAfterRenaming;
-		}
 	      else if (tail_index == name_len)
 		return type;
 	      else 


More information about the Gdb-patches mailing list