diff options
author | Joel Brobecker <brobecker@gnat.com> | 2007-12-21 11:50:11 +0000 |
---|---|---|
committer | Joel Brobecker <brobecker@gnat.com> | 2007-12-21 11:50:11 +0000 |
commit | aeb5907d62fcf44215d7112b8623f889ef73b2dd (patch) | |
tree | b06cebbe9e21b56e1f9bcfd7bfe2a83b76fcfcd0 /gdb | |
parent | 27a98bd991f63159d01e6aa8213cebd8487c8802 (diff) | |
download | gdb-aeb5907d62fcf44215d7112b8623f889ef73b2dd.zip gdb-aeb5907d62fcf44215d7112b8623f889ef73b2dd.tar.gz gdb-aeb5907d62fcf44215d7112b8623f889ef73b2dd.tar.bz2 |
* 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.
Diffstat (limited to 'gdb')
-rw-r--r-- | gdb/ChangeLog | 35 | ||||
-rw-r--r-- | gdb/ada-exp.y | 231 | ||||
-rw-r--r-- | gdb/ada-lang.c | 382 | ||||
-rw-r--r-- | gdb/ada-lang.h | 35 |
4 files changed, 475 insertions, 208 deletions
diff --git a/gdb/ChangeLog b/gdb/ChangeLog index f9f2364..86be830 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,38 @@ +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. + 2007-12-21 Denis Pilat <denis.pilat@st.com> * tui/tui-data.h (MAX_LOCATOR_ELEMENT_LEN): Defined to a bigger diff --git a/gdb/ada-exp.y b/gdb/ada-exp.y index 1cf86a3..4a87d33 100644 --- a/gdb/ada-exp.y +++ b/gdb/ada-exp.y @@ -124,7 +124,8 @@ static struct stoken string_to_operator (struct stoken); 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_opcode opcode, struct stoken token) 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 *orig_left_context, { 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) { @@ -965,18 +969,18 @@ write_object_renaming (struct block *orig_left_context, { 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 *orig_left_context, 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, struct stoken name0) 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, struct stoken name0) /* 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 diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c index fa1068f..d549662 100644 --- a/gdb/ada-lang.c +++ b/gdb/ada-lang.c @@ -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_opcode op, struct value *args[]) /* 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; +} @@ -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 *sym, char *function_name) 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 *sym, char *function_name) 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 ada_symbol_info *syms, 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, const struct block *block0, } } 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_len, const char *name0) { 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_len, const char *name0) 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_len, const char *name0) { 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 *name, struct block *block) /* 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, struct type *type1) 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; } diff --git a/gdb/ada-lang.h b/gdb/ada-lang.h index 307ca21..0bef685 100644 --- a/gdb/ada-lang.h +++ b/gdb/ada-lang.h @@ -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 (const char *, const struct block *, 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 type *, LONGEST, struct ui_file *); 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 *); |