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);
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);
{
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);
-
- 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);
+ end = renaming_expr + strlen (renaming_expr);
+
+ 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)
{
{
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;
}
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*
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';
/* 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
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 *);
\f
/* 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. */
+/* NOTES:
+
+ 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 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. */
-
-const char *
-ada_renaming_type (struct type *type)
-{
- if (type != NULL && TYPE_CODE (type) == TYPE_CODE_ENUM)
+ 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)
-{
- const char *renaming_type = ada_renaming_type (SYMBOL_TYPE (sym));
- return renaming_type != NULL
- && (renaming_type[2] == '\0' || renaming_type[2] == '_');
-}
-
-/* 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. */
-
-char *
-ada_simple_renamed_entity (struct symbol *sym)
-{
- struct type *type;
- const char *raw_name;
- int len;
- char *result;
- type = SYMBOL_TYPE (sym);
- if (type == NULL || TYPE_NFIELDS (type) < 1)
- error (_("Improperly encoded renaming."));
+ 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)
+{
+ enum ada_renaming_category kind;
+ const char *name;
+ const char *info;
+ const char *suffix;
- raw_name = TYPE_FIELD_NAME (type, 0);
- len = (raw_name == NULL ? 0 : strlen (raw_name)) - 5;
- if (len <= 0)
- error (_("Improperly encoded renaming."));
+ if (type == NULL || TYPE_CODE (type) != TYPE_CODE_ENUM
+ || TYPE_NFIELDS (type) != 1)
+ return ADA_NOT_RENAMING;
- result = xmalloc (len + 1);
- strncpy (result, raw_name, len);
- result[len] = '\000';
- return 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;
+ }
+
+ 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;
+}
\f
}
/* 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. */
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
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. */
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;
}
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)
{
}
}
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 *
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)
{
int name_len;
char *name;
+ char *name_start;
char *patn;
/* FIXME: brobecker/2003-11-10: For some reason, the symbol name
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))
{
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;
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;
/* 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)
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;
}
projects / external / binutils.git / commitdiff