/* Ada language support routines for GDB, the GNU debugger.
- Copyright (C) 1992-2017 Free Software Foundation, Inc.
+ Copyright (C) 1992-2018 Free Software Foundation, Inc.
This file is part of GDB.
#include "annotate.h"
#include "valprint.h"
#include "source.h"
-#include "observer.h"
+#include "observable.h"
#include "vec.h"
#include "stack.h"
#include "gdb_vecs.h"
static struct block_symbol *defns_collected (struct obstack *, int);
-static struct value *resolve_subexp (struct expression **, int *, int,
+static struct value *resolve_subexp (expression_up *, int *, int,
struct type *);
-static void replace_operator_with_call (struct expression **, int, int, int,
+static void replace_operator_with_call (expression_up *, int, int, int,
struct symbol *, const struct block *);
static int possible_user_operator_p (enum exp_opcode, struct value **);
static int find_struct_field (const char *, struct type *, int,
struct type **, int *, int *, int *, int *);
-static struct value *ada_to_fixed_value_create (struct type *, CORE_ADDR,
- struct value *);
-
static int ada_resolve_function (struct block_symbol *, int,
struct value **, int, const char *,
struct type *);
ADA_KNOWN_AUXILIARY_FUNCTION_NAME_PATTERNS NULL
};
-/* Space for allocating results of ada_lookup_symbol_list. */
-static struct obstack symbol_list_obstack;
-
/* Maintenance-related settings for this module. */
static struct cmd_list_element *maint_set_ada_cmdlist;
ada_main_name (void)
{
struct bound_minimal_symbol msym;
- static char *main_program_name = NULL;
+ static gdb::unique_xmalloc_ptr<char> main_program_name;
/* For Ada, the name of the main procedure is stored in a specific
string constant, generated by the binder. Look for that symbol,
if (main_program_name_addr == 0)
error (_("Invalid address for Ada main program name."));
- xfree (main_program_name);
target_read_string (main_program_name_addr, &main_program_name,
1024, &err_code);
if (err_code != 0)
return NULL;
- return main_program_name;
+ return main_program_name.get ();
}
/* The main procedure doesn't seem to be in Ada. */
struct type *base_index_type = TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (type0));
struct type *index_type
= create_static_range_type (NULL, base_index_type, low, high);
- struct type *slice_type =
- create_array_type (NULL, TYPE_TARGET_TYPE (type0), index_type);
+ struct type *slice_type = create_array_type_with_stride
+ (NULL, TYPE_TARGET_TYPE (type0), index_type,
+ get_dyn_prop (DYN_PROP_BYTE_STRIDE, type0),
+ TYPE_FIELD_BITSIZE (type0, 0));
int base_low = ada_discrete_type_low_bound (TYPE_INDEX_TYPE (type0));
LONGEST base_low_pos, low_pos;
CORE_ADDR base;
struct type *base_index_type = TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (type));
struct type *index_type
= create_static_range_type (NULL, TYPE_INDEX_TYPE (type), low, high);
- struct type *slice_type =
- create_array_type (NULL, TYPE_TARGET_TYPE (type), index_type);
+ struct type *slice_type = create_array_type_with_stride
+ (NULL, TYPE_TARGET_TYPE (type), index_type,
+ get_dyn_prop (DYN_PROP_BYTE_STRIDE, type),
+ TYPE_FIELD_BITSIZE (type, 0));
LONGEST low_pos, high_pos;
if (!discrete_position (base_index_type, low, &low_pos)
}
arr_type = check_typedef (arr_type);
- index_type = TYPE_INDEX_TYPE (arr_type);
+ index_type = ada_index_type (arr_type, n, "length");
if (index_type != NULL)
{
struct type *base_type;
return type is preferred. May change (expand) *EXP. */
static void
-resolve (struct expression **expp, int void_context_p)
+resolve (expression_up *expp, int void_context_p)
{
struct type *context_type = NULL;
int pc = 0;
are as in ada_resolve, above. */
static struct value *
-resolve_subexp (struct expression **expp, int *pos, int deprocedure_p,
+resolve_subexp (expression_up *expp, int *pos, int deprocedure_p,
struct type *context_type)
{
int pc = *pos;
struct value **argvec; /* Vector of operand types (alloca'ed). */
int nargs; /* Number of operands. */
int oplen;
+ struct cleanup *old_chain = make_cleanup (null_cleanup, NULL);
argvec = NULL;
nargs = 0;
- exp = *expp;
+ exp = expp->get ();
/* Pass one: resolve operands, saving their types and updating *pos,
if needed. */
for (i = 0; i < nargs; i += 1)
argvec[i] = resolve_subexp (expp, pos, 1, NULL);
argvec[i] = NULL;
- exp = *expp;
+ exp = expp->get ();
/* Pass two: perform any resolution on principal operator. */
switch (op)
(exp->elts[pc + 2].symbol),
exp->elts[pc + 1].block, VAR_DOMAIN,
&candidates);
+ make_cleanup (xfree, candidates);
if (n_candidates > 1)
{
exp->elts[pc + 1].block = candidates[i].block;
exp->elts[pc + 2].symbol = candidates[i].symbol;
- if (innermost_block == NULL
- || contained_in (candidates[i].block, innermost_block))
- innermost_block = candidates[i].block;
+ innermost_block.update (candidates[i]);
}
if (deprocedure_p
replace_operator_with_call (expp, pc, 0, 0,
exp->elts[pc + 2].symbol,
exp->elts[pc + 1].block);
- exp = *expp;
+ exp = expp->get ();
}
break;
(exp->elts[pc + 5].symbol),
exp->elts[pc + 4].block, VAR_DOMAIN,
&candidates);
+ make_cleanup (xfree, candidates);
+
if (n_candidates == 1)
i = 0;
else
exp->elts[pc + 4].block = candidates[i].block;
exp->elts[pc + 5].symbol = candidates[i].symbol;
- if (innermost_block == NULL
- || contained_in (candidates[i].block, innermost_block))
- innermost_block = candidates[i].block;
+ innermost_block.update (candidates[i]);
}
}
break;
ada_lookup_symbol_list (ada_decoded_op_name (op),
(struct block *) NULL, VAR_DOMAIN,
&candidates);
+ make_cleanup (xfree, candidates);
+
i = ada_resolve_function (candidates, n_candidates, argvec, nargs,
ada_decoded_op_name (op), NULL);
if (i < 0)
replace_operator_with_call (expp, pc, nargs, 1,
candidates[i].symbol,
candidates[i].block);
- exp = *expp;
+ exp = expp->get ();
}
break;
case OP_TYPE:
case OP_REGISTER:
+ do_cleanups (old_chain);
return NULL;
}
*pos = pc;
+ do_cleanups (old_chain);
if (exp->elts[pc].opcode == OP_VAR_MSYM_VALUE)
return evaluate_var_msym_value (EVAL_AVOID_SIDE_EFFECTS,
exp->elts[pc + 1].objfile,
arguments. Update *EXPP as needed to hold more space. */
static void
-replace_operator_with_call (struct expression **expp, int pc, int nargs,
+replace_operator_with_call (expression_up *expp, int pc, int nargs,
int oplen, struct symbol *sym,
const struct block *block)
{
struct expression *newexp = (struct expression *)
xzalloc (sizeof (struct expression)
+ EXP_ELEM_TO_BYTES ((*expp)->nelts + 7 - oplen));
- struct expression *exp = *expp;
+ struct expression *exp = expp->get ();
newexp->nelts = exp->nelts + 7 - oplen;
newexp->language_defn = exp->language_defn;
newexp->elts[pc + 4].block = block;
newexp->elts[pc + 5].symbol = sym;
- *expp = newexp;
- xfree (exp);
+ expp->reset (newexp);
}
/* Type-class predicates */
if (TYPE_CODE (formal_target) == TYPE_CODE_ARRAY
&& ada_is_array_descriptor_type (actual_target))
result = desc_data (actual);
- else if (TYPE_CODE (actual_type) != TYPE_CODE_PTR)
+ else if (TYPE_CODE (formal_type) != TYPE_CODE_PTR)
{
if (VALUE_LVAL (actual) != lval_memory)
{
searching for all symbols matching LOOKUP_NAME.
LOOKUP_NAME is expected to be a symbol name after transformation
- for Ada lookups (see ada_name_for_lookup). */
+ for Ada lookups. */
static symbol_name_match_type
name_match_type_from_name (const char *lookup_name)
/* Find symbols in DOMAIN matching LOOKUP_NAME, in BLOCK and, if FULL_SEARCH
is non-zero, enclosing scope and in global scopes, returning the number of
matches.
- Sets *RESULTS to point to a vector of (SYM,BLOCK) tuples,
+ Sets *RESULTS to point to a newly allocated vector of (SYM,BLOCK) tuples,
indicating the symbols found and the blocks and symbol tables (if
- any) in which they were found. This vector is transient---good only to
- the next call of ada_lookup_symbol_list.
+ any) in which they were found. This vector should be freed when
+ no longer useful.
When full_search is non-zero, any non-function/non-enumeral
symbol match within the nest of blocks whose innermost member is BLOCK,
{
int syms_from_global_search;
int ndefns;
+ int results_size;
+ auto_obstack obstack;
- obstack_free (&symbol_list_obstack, NULL);
- obstack_init (&symbol_list_obstack);
- ada_add_all_symbols (&symbol_list_obstack, block, lookup_name,
+ ada_add_all_symbols (&obstack, block, lookup_name,
domain, full_search, &syms_from_global_search);
- ndefns = num_defns_collected (&symbol_list_obstack);
- *results = defns_collected (&symbol_list_obstack, 1);
+ ndefns = num_defns_collected (&obstack);
+
+ results_size = obstack_object_size (&obstack);
+ *results = (struct block_symbol *) malloc (results_size);
+ memcpy (*results, defns_collected (&obstack, 1), results_size);
ndefns = remove_extra_symbols (*results, ndefns);
(*results)[0].symbol, (*results)[0].block);
ndefns = remove_irrelevant_renamings (*results, ndefns, block);
+
return ndefns;
}
/* Find symbols in DOMAIN matching NAME, in BLOCK and enclosing scope and
in global scopes, returning the number of matches, and setting *RESULTS
- to a vector of (SYM,BLOCK) tuples.
+ to a newly-allocated vector of (SYM,BLOCK) tuples. This newly-allocated
+ vector should be freed when no longer useful.
+
See ada_lookup_symbol_list_worker for further details. */
int
{
int ndefs, i;
struct block_symbol *results;
+ struct cleanup *old_chain;
ndefs = ada_lookup_symbol_list_worker (name, block, domain, &results, 0);
+ old_chain = make_cleanup (xfree, results);
+
for (i = 0; i < ndefs; ++i)
{
if (!callback (results[i].symbol))
break;
}
+
+ do_cleanups (old_chain);
}
/* The result is as for ada_lookup_symbol_list with FULL_SEARCH set
domain_enum domain,
struct block_symbol *info)
{
- struct block_symbol *candidates;
- int n_candidates;
-
/* Since we already have an encoded name, wrap it in '<>' to force a
verbatim match. Otherwise, if the name happens to not look like
an encoded name (because it doesn't include a "__"),
std::string verbatim = std::string ("<") + name + '>';
gdb_assert (info != NULL);
- memset (info, 0, sizeof (struct block_symbol));
-
- n_candidates = ada_lookup_symbol_list (verbatim.c_str (), block,
- domain, &candidates);
- if (n_candidates == 0)
- return;
-
- *info = candidates[0];
- info->symbol = fixup_symbol_section (info->symbol, NULL);
+ *info = ada_lookup_symbol (verbatim.c_str (), block, domain, NULL);
}
/* Return a symbol in DOMAIN matching NAME, in BLOCK0 and enclosing
ada_lookup_symbol (const char *name, const struct block *block0,
domain_enum domain, int *is_a_field_of_this)
{
- struct block_symbol info;
-
if (is_a_field_of_this != NULL)
*is_a_field_of_this = 0;
- ada_lookup_encoded_symbol (ada_encode (ada_fold_name (name)),
- block0, domain, &info);
+ struct block_symbol *candidates;
+ int n_candidates;
+ struct cleanup *old_chain;
+
+ n_candidates = ada_lookup_symbol_list (name, block0, domain, &candidates);
+ old_chain = make_cleanup (xfree, candidates);
+
+ if (n_candidates == 0)
+ {
+ do_cleanups (old_chain);
+ return {};
+ }
+
+ block_symbol info = candidates[0];
+ info.symbol = fixup_symbol_section (info.symbol, NULL);
+
+ do_cleanups (old_chain);
+
return info;
}
ada_lookup_name_info::matches
(const char *sym_name,
symbol_name_match_type match_type,
- completion_match *comp_match) const
+ completion_match_result *comp_match_res) const
{
bool match = false;
const char *text = m_encoded_name.c_str ();
if (!match)
return false;
- if (comp_match != NULL)
+ if (comp_match_res != NULL)
{
- std::string &match_str = comp_match->storage ();
+ std::string &match_str = comp_match_res->match.storage ();
if (!m_encoded_p)
- {
- match_str = ada_decode (sym_name);
- comp_match->set_match (match_str.c_str ());
- }
+ match_str = ada_decode (sym_name);
else
{
if (m_verbatim_p)
else
match_str = sym_name;
- comp_match->set_match (match_str.c_str ());
}
+
+ comp_match_res->set_match (match_str.c_str ());
}
return true;
struct minimal_symbol *msymbol;
struct objfile *objfile;
const struct block *b, *surrounding_static_block = 0;
- int i;
struct block_iterator iter;
struct cleanup *old_chain = make_cleanup (null_cleanup, NULL);
if (completion_skip_symbol (mode, msymbol))
continue;
+ language symbol_language = MSYMBOL_LANGUAGE (msymbol);
+
+ /* Ada minimal symbols won't have their language set to Ada. If
+ we let completion_list_add_name compare using the
+ default/C-like matcher, then when completing e.g., symbols in a
+ package named "pck", we'd match internal Ada symbols like
+ "pckS", which are invalid in an Ada expression, unless you wrap
+ them in '<' '>' to request a verbatim match.
+
+ Unfortunately, some Ada encoded names successfully demangle as
+ C++ symbols (using an old mangling scheme), such as "name__2Xn"
+ -> "Xn::name(void)" and thus some Ada minimal symbols end up
+ with the wrong language set. Paper over that issue here. */
+ if (symbol_language == language_auto
+ || symbol_language == language_cplus)
+ symbol_language = language_ada;
+
completion_list_add_name (tracker,
- MSYMBOL_LANGUAGE (msymbol),
+ symbol_language,
MSYMBOL_LINKAGE_NAME (msymbol),
lookup_name, text, word);
}
if (is_ada95_tag (tag))
return obj;
- ptr_type = builtin_type (target_gdbarch ())->builtin_data_ptr;
+ ptr_type = language_lookup_primitive_type
+ (language_def (language_ada), target_gdbarch(), "storage_offset");
ptr_type = lookup_pointer_type (ptr_type);
val = value_cast (ptr_type, tag);
if (!val)
if (offset_to_top == -1)
return obj;
- base_address = value_address (obj) - offset_to_top;
+ /* OFFSET_TO_TOP used to be a positive value to be subtracted
+ from the base address. This was however incompatible with
+ C++ dispatch table: C++ uses a *negative* value to *add*
+ to the base address. Ada's convention has therefore been
+ changed in GNAT 19.0w 20171023: since then, C++ and Ada
+ use the same convention. Here, we support both cases by
+ checking the sign of OFFSET_TO_TOP. */
+
+ if (offset_to_top > 0)
+ offset_to_top = -offset_to_top;
+
+ base_address = value_address (obj) + offset_to_top;
tag = value_tag_from_contents_and_address (obj_type, NULL, base_address);
/* Make sure that we have a proper tag at the new address.
number of fields if not found. A NULL value of NAME never
matches; the function just counts visible fields in this case.
+ Notice that we need to handle when a tagged record hierarchy
+ has some components with the same name, like in this scenario:
+
+ type Top_T is tagged record
+ N : Integer := 1;
+ U : Integer := 974;
+ A : Integer := 48;
+ end record;
+
+ type Middle_T is new Top.Top_T with record
+ N : Character := 'a';
+ C : Integer := 3;
+ end record;
+
+ type Bottom_T is new Middle.Middle_T with record
+ N : Float := 4.0;
+ C : Character := '5';
+ X : Integer := 6;
+ A : Character := 'J';
+ end record;
+
+ Let's say we now have a variable declared and initialized as follow:
+
+ TC : Top_A := new Bottom_T;
+
+ And then we use this variable to call this function
+
+ procedure Assign (Obj: in out Top_T; TV : Integer);
+
+ as follow:
+
+ Assign (Top_T (B), 12);
+
+ Now, we're in the debugger, and we're inside that procedure
+ then and we want to print the value of obj.c:
+
+ Usually, the tagged record or one of the parent type owns the
+ component to print and there's no issue but in this particular
+ case, what does it mean to ask for Obj.C? Since the actual
+ type for object is type Bottom_T, it could mean two things: type
+ component C from the Middle_T view, but also component C from
+ Bottom_T. So in that "undefined" case, when the component is
+ not found in the non-resolved type (which includes all the
+ components of the parent type), then resolve it and see if we
+ get better luck once expanded.
+
+ In the case of homonyms in the derived tagged type, we don't
+ guaranty anything, and pick the one that's easiest for us
+ to program.
+
Returns 1 if found, 0 otherwise. */
static int
int *index_p)
{
int i;
+ int parent_offset = -1;
type = ada_check_typedef (type);
if (t_field_name == NULL)
continue;
+ else if (ada_is_parent_field (type, i))
+ {
+ /* This is a field pointing us to the parent type of a tagged
+ type. As hinted in this function's documentation, we give
+ preference to fields in the current record first, so what
+ we do here is just record the index of this field before
+ we skip it. If it turns out we couldn't find our field
+ in the current record, then we'll get back to it and search
+ inside it whether the field might exist in the parent. */
+
+ parent_offset = i;
+ continue;
+ }
+
else if (name != NULL && field_name_match (t_field_name, name))
{
int bit_size = TYPE_FIELD_BITSIZE (type, i);
else if (index_p != NULL)
*index_p += 1;
}
+
+ /* Field not found so far. If this is a tagged type which
+ has a parent, try finding that field in the parent now. */
+
+ if (parent_offset != -1)
+ {
+ int bit_pos = TYPE_FIELD_BITPOS (type, parent_offset);
+ int fld_offset = offset + bit_pos / 8;
+
+ if (find_struct_field (name, TYPE_FIELD_TYPE (type, parent_offset),
+ fld_offset, field_type_p, byte_offset_p,
+ bit_offset_p, bit_size_p, index_p))
+ return 1;
+ }
+
return 0;
}
and search in it assuming it has (class) type TYPE.
If found, return value, else return NULL.
- Searches recursively through wrapper fields (e.g., '_parent'). */
+ Searches recursively through wrapper fields (e.g., '_parent').
+
+ In the case of homonyms in the tagged types, please refer to the
+ long explanation in find_struct_field's function documentation. */
static struct value *
ada_search_struct_field (const char *name, struct value *arg, int offset,
struct type *type)
{
int i;
+ int parent_offset = -1;
type = ada_check_typedef (type);
for (i = 0; i < TYPE_NFIELDS (type); i += 1)
if (t_field_name == NULL)
continue;
+ else if (ada_is_parent_field (type, i))
+ {
+ /* This is a field pointing us to the parent type of a tagged
+ type. As hinted in this function's documentation, we give
+ preference to fields in the current record first, so what
+ we do here is just record the index of this field before
+ we skip it. If it turns out we couldn't find our field
+ in the current record, then we'll get back to it and search
+ inside it whether the field might exist in the parent. */
+
+ parent_offset = i;
+ continue;
+ }
+
else if (field_name_match (t_field_name, name))
return ada_value_primitive_field (arg, offset, i, type);
}
}
}
+
+ /* Field not found so far. If this is a tagged type which
+ has a parent, try finding that field in the parent now. */
+
+ if (parent_offset != -1)
+ {
+ struct value *v = ada_search_struct_field (
+ name, arg, offset + TYPE_FIELD_BITPOS (type, parent_offset) / 8,
+ TYPE_FIELD_TYPE (type, parent_offset));
+
+ if (v != NULL)
+ return v;
+ }
+
return NULL;
}
else
address = value_address (ada_coerce_ref (arg));
- t1 = ada_to_fixed_type (ada_get_base_type (t1), NULL, address, NULL, 1);
+ /* Check to see if this is a tagged type. We also need to handle
+ the case where the type is a reference to a tagged type, but
+ we have to be careful to exclude pointers to tagged types.
+ The latter should be shown as usual (as a pointer), whereas
+ a reference should mostly be transparent to the user. */
+
+ if (ada_is_tagged_type (t1, 0)
+ || (TYPE_CODE (t1) == TYPE_CODE_REF
+ && ada_is_tagged_type (TYPE_TARGET_TYPE (t1), 0)))
+ {
+ /* We first try to find the searched field in the current type.
+ If not found then let's look in the fixed type. */
+
+ if (!find_struct_field (name, t1, 0,
+ &field_type, &byte_offset, &bit_offset,
+ &bit_size, NULL))
+ t1 = ada_to_fixed_type (ada_get_base_type (t1), NULL,
+ address, NULL, 1);
+ }
+ else
+ t1 = ada_to_fixed_type (ada_get_base_type (t1), NULL,
+ address, NULL, 1);
+
if (find_struct_field (name, t1, 0,
&field_type, &byte_offset, &bit_offset,
&bit_size, NULL))
Looks recursively into variant clauses and parent types.
+ In the case of homonyms in the tagged types, please refer to the
+ long explanation in find_struct_field's function documentation.
+
If NOERR is nonzero, return NULL if NAME is not suitably defined or
TYPE is not a type of the right kind. */
int noerr)
{
int i;
+ int parent_offset = -1;
if (name == NULL)
goto BadName;
if (t_field_name == NULL)
continue;
+ else if (ada_is_parent_field (type, i))
+ {
+ /* This is a field pointing us to the parent type of a tagged
+ type. As hinted in this function's documentation, we give
+ preference to fields in the current record first, so what
+ we do here is just record the index of this field before
+ we skip it. If it turns out we couldn't find our field
+ in the current record, then we'll get back to it and search
+ inside it whether the field might exist in the parent. */
+
+ parent_offset = i;
+ continue;
+ }
+
else if (field_name_match (t_field_name, name))
return TYPE_FIELD_TYPE (type, i);
}
+ /* Field not found so far. If this is a tagged type which
+ has a parent, try finding that field in the parent now. */
+
+ if (parent_offset != -1)
+ {
+ struct type *t;
+
+ t = ada_lookup_struct_elt_type (TYPE_FIELD_TYPE (type, parent_offset),
+ name, 0, 1);
+ if (t != NULL)
+ return t;
+ }
+
BadName:
if (!noerr)
{
ada_is_redundant_range_encoding (struct type *range_type,
struct type *encoding_type)
{
- struct type *fixed_range_type;
const char *bounds_str;
int n;
LONGEST lo, hi;
const char *name = ada_type_name (fixed_record_type);
char *xvz_name
= (char *) alloca (strlen (name) + 7 /* "___XVZ\0" */);
+ bool xvz_found = false;
LONGEST size;
xsnprintf (xvz_name, strlen (name) + 7, "%s___XVZ", name);
- if (get_int_var_value (xvz_name, size)
- && TYPE_LENGTH (fixed_record_type) != size)
+ TRY
+ {
+ xvz_found = get_int_var_value (xvz_name, size);
+ }
+ CATCH (except, RETURN_MASK_ERROR)
+ {
+ /* We found the variable, but somehow failed to read
+ its value. Rethrow the same error, but with a little
+ bit more information, to help the user understand
+ what went wrong (Eg: the variable might have been
+ optimized out). */
+ throw_error (except.error,
+ _("unable to read value of %s (%s)"),
+ xvz_name, except.message);
+ }
+ END_CATCH
+
+ if (xvz_found && TYPE_LENGTH (fixed_record_type) != size)
{
fixed_record_type = copy_type (fixed_record_type);
TYPE_LENGTH (fixed_record_type) = size;
if (type == type0 && val0 != NULL)
return val0;
- else
- return value_from_contents_and_address (type, 0, address);
+
+ if (VALUE_LVAL (val0) != lval_memory)
+ {
+ /* Our value does not live in memory; it could be a convenience
+ variable, for instance. Create a not_lval value using val0's
+ contents. */
+ return value_from_contents (type, value_contents (val0));
+ }
+
+ return value_from_contents_and_address (type, 0, address);
}
/* A value representing VAL, but with a standard (static-sized) type
if (ada_is_direct_array_type (value_type (arg1))
|| ada_is_direct_array_type (value_type (arg2)))
{
+ struct type *arg1_type, *arg2_type;
+
/* Automatically dereference any array reference before
we attempt to perform the comparison. */
arg1 = ada_coerce_ref (arg1);
arg2 = ada_coerce_ref (arg2);
-
+
arg1 = ada_coerce_to_simple_array (arg1);
arg2 = ada_coerce_to_simple_array (arg2);
- if (TYPE_CODE (value_type (arg1)) != TYPE_CODE_ARRAY
- || TYPE_CODE (value_type (arg2)) != TYPE_CODE_ARRAY)
+
+ arg1_type = ada_check_typedef (value_type (arg1));
+ arg2_type = ada_check_typedef (value_type (arg2));
+
+ if (TYPE_CODE (arg1_type) != TYPE_CODE_ARRAY
+ || TYPE_CODE (arg2_type) != TYPE_CODE_ARRAY)
error (_("Attempt to compare array with non-array"));
/* FIXME: The following works only for types whose
representations use all bits (no padding or undefined bits)
and do not have user-defined equality. */
- return
- TYPE_LENGTH (value_type (arg1)) == TYPE_LENGTH (value_type (arg2))
- && memcmp (value_contents (arg1), value_contents (arg2),
- TYPE_LENGTH (value_type (arg1))) == 0;
+ return (TYPE_LENGTH (arg1_type) == TYPE_LENGTH (arg2_type)
+ && memcmp (value_contents (arg1), value_contents (arg2),
+ TYPE_LENGTH (arg1_type)) == 0);
}
return value_equal (arg1, arg2);
}
{
struct value *mark = value_mark ();
struct value *elt;
+ struct type *lhs_type = check_typedef (value_type (lhs));
- if (TYPE_CODE (value_type (lhs)) == TYPE_CODE_ARRAY)
+ if (TYPE_CODE (lhs_type) == TYPE_CODE_ARRAY)
{
struct type *index_type = builtin_type (exp->gdbarch)->builtin_int;
struct value *index_val = value_from_longest (index_type, index);
if (!deprecated_value_modifiable (lhs))
error (_("Left operand of assignment is not a modifiable lvalue."));
- lhs_type = value_type (lhs);
+ lhs_type = check_typedef (value_type (lhs));
if (ada_is_direct_array_type (lhs_type))
{
lhs = ada_coerce_to_simple_array (lhs);
- lhs_type = value_type (lhs);
+ lhs_type = check_typedef (value_type (lhs));
low_index = TYPE_ARRAY_LOWER_BOUND_VALUE (lhs_type);
high_index = TYPE_ARRAY_UPPER_BOUND_VALUE (lhs_type);
}
int nsyms = ada_lookup_symbol_list_worker (lookup_name,
get_selected_block (0),
VAR_DOMAIN, &syms, 1);
+ struct cleanup *old_chain = make_cleanup (xfree, syms);
if (nsyms != 1)
{
+ do_cleanups (old_chain);
if (err_msg == NULL)
return 0;
else
error (("%s"), err_msg);
}
- return value_of_variable (syms[0].symbol, syms[0].block);
+ struct value *result = value_of_variable (syms[0].symbol, syms[0].block);
+ do_cleanups (old_chain);
+ return result;
}
/* Value of integer variable named NAME in the current environment.
type = create_static_range_type (alloc_type_copy (raw_type),
base_type, L, U);
+ /* create_static_range_type alters the resulting type's length
+ to match the size of the base_type, which is not what we want.
+ Set it back to the original range type's length. */
+ TYPE_LENGTH (type) = TYPE_LENGTH (raw_type);
TYPE_NAME (type) = name;
return type;
}
a catchpoint on failed assertions. */
const char *catch_assert_sym;
+ /* The name of the symbol to break on in order to insert
+ a catchpoint on exception handling. */
+ const char *catch_handlers_sym;
+
/* Assuming that the inferior just triggered an unhandled exception
catchpoint, this function is responsible for returning the address
in inferior memory where the name of that exception is stored.
"__gnat_debug_raise_exception", /* catch_exception_sym */
"__gnat_unhandled_exception", /* catch_exception_unhandled_sym */
"__gnat_debug_raise_assert_failure", /* catch_assert_sym */
+ "__gnat_begin_handler", /* catch_handlers_sym */
ada_unhandled_exception_name_addr
};
"__gnat_raise_nodefer_with_msg", /* catch_exception_sym */
"__gnat_unhandled_exception", /* catch_exception_unhandled_sym */
"system__assertions__raise_assert_failure", /* catch_assert_sym */
+ "__gnat_begin_handler", /* catch_handlers_sym */
ada_unhandled_exception_name_addr_from_raise
};
case ada_catch_exception_unhandled:
return data->exception_info->unhandled_exception_name_addr ();
break;
-
+
+ case ada_catch_handlers:
+ return 0; /* The runtimes does not provide access to the exception
+ name. */
+ break;
+
case ada_catch_assert:
return 0; /* Exception name is not relevant in this case. */
break;
return result;
}
-static char *ada_exception_catchpoint_cond_string (const char *excep_string);
+static char *ada_exception_catchpoint_cond_string
+ (const char *excep_string,
+ enum ada_exception_catchpoint_kind ex);
/* Ada catchpoints.
catchpoint's locations, and store them for later evaluation. */
static void
-create_excep_cond_exprs (struct ada_catchpoint *c)
+create_excep_cond_exprs (struct ada_catchpoint *c,
+ enum ada_exception_catchpoint_kind ex)
{
struct cleanup *old_chain;
struct bp_location *bl;
/* Compute the condition expression in text form, from the specific
expection we want to catch. */
- cond_string = ada_exception_catchpoint_cond_string (c->excep_string);
+ cond_string = ada_exception_catchpoint_cond_string (c->excep_string, ex);
old_chain = make_cleanup (xfree, cond_string);
/* Iterate over all the catchpoint's locations, and parse an
/* Reparse the exception conditional expressions. One for each
location. */
- create_excep_cond_exprs (c);
+ create_excep_cond_exprs (c, ex);
}
/* Returns true if we should stop for this breakpoint hit. If the
{
case ada_catch_exception:
case ada_catch_exception_unhandled:
+ case ada_catch_handlers:
{
const CORE_ADDR addr = ada_exception_name_addr (ex, b);
char exception_name[256];
uiout->field_string ("what", "unhandled Ada exceptions");
break;
+ case ada_catch_handlers:
+ if (c->excep_string != NULL)
+ {
+ uiout->field_fmt ("what",
+ _("`%s' Ada exception handlers"),
+ c->excep_string);
+ }
+ else
+ uiout->field_string ("what", "all Ada exceptions handlers");
+ break;
+
case ada_catch_assert:
uiout->field_string ("what", "failed Ada assertions");
break;
case ada_catch_exception_unhandled:
uiout->text (_("unhandled Ada exceptions"));
break;
-
+
+ case ada_catch_handlers:
+ if (c->excep_string != NULL)
+ {
+ std::string info
+ = string_printf (_("`%s' Ada exception handlers"),
+ c->excep_string);
+ uiout->text (info.c_str ());
+ }
+ else
+ uiout->text (_("all Ada exceptions handlers"));
+ break;
+
case ada_catch_assert:
uiout->text (_("failed Ada assertions"));
break;
fprintf_filtered (fp, "catch exception unhandled");
break;
+ case ada_catch_handlers:
+ fprintf_filtered (fp, "catch handlers");
+ break;
+
case ada_catch_assert:
fprintf_filtered (fp, "catch assert");
break;
static struct breakpoint_ops catch_assert_breakpoint_ops;
+/* Virtual table for "catch handlers" breakpoints. */
+
+static struct bp_location *
+allocate_location_catch_handlers (struct breakpoint *self)
+{
+ return allocate_location_exception (ada_catch_handlers, self);
+}
+
+static void
+re_set_catch_handlers (struct breakpoint *b)
+{
+ re_set_exception (ada_catch_handlers, b);
+}
+
+static void
+check_status_catch_handlers (bpstat bs)
+{
+ check_status_exception (ada_catch_handlers, bs);
+}
+
+static enum print_stop_action
+print_it_catch_handlers (bpstat bs)
+{
+ return print_it_exception (ada_catch_handlers, bs);
+}
+
+static void
+print_one_catch_handlers (struct breakpoint *b,
+ struct bp_location **last_loc)
+{
+ print_one_exception (ada_catch_handlers, b, last_loc);
+}
+
+static void
+print_mention_catch_handlers (struct breakpoint *b)
+{
+ print_mention_exception (ada_catch_handlers, b);
+}
+
+static void
+print_recreate_catch_handlers (struct breakpoint *b,
+ struct ui_file *fp)
+{
+ print_recreate_exception (ada_catch_handlers, b, fp);
+}
+
+static struct breakpoint_ops catch_handlers_breakpoint_ops;
+
/* Return a newly allocated copy of the first space-separated token
in ARGSP, and then adjust ARGSP to point immediately after that
token.
Set EX to the appropriate catchpoint type.
Set EXCEP_STRING to the name of the specific exception if
specified by the user.
+ IS_CATCH_HANDLERS_CMD: True if the arguments are for a
+ "catch handlers" command. False otherwise.
If a condition is found at the end of the arguments, the condition
expression is stored in COND_STRING (memory must be deallocated
after use). Otherwise COND_STRING is set to NULL. */
static void
catch_ada_exception_command_split (const char *args,
+ bool is_catch_handlers_cmd,
enum ada_exception_catchpoint_kind *ex,
char **excep_string,
- char **cond_string)
+ std::string &cond_string)
{
struct cleanup *old_chain = make_cleanup (null_cleanup, NULL);
char *exception_name;
discard_cleanups (old_chain);
- if (exception_name == NULL)
+ if (is_catch_handlers_cmd)
+ {
+ /* Catch handling of exceptions. */
+ *ex = ada_catch_handlers;
+ *excep_string = exception_name;
+ }
+ else if (exception_name == NULL)
{
/* Catch all exceptions. */
*ex = ada_catch_exception;
*ex = ada_catch_exception;
*excep_string = exception_name;
}
- *cond_string = cond;
+ if (cond != NULL)
+ cond_string.assign (cond);
}
/* Return the name of the symbol on which we should break in order to
case ada_catch_assert:
return (data->exception_info->catch_assert_sym);
break;
+ case ada_catch_handlers:
+ return (data->exception_info->catch_handlers_sym);
+ break;
default:
internal_error (__FILE__, __LINE__,
_("unexpected catchpoint kind (%d)"), ex);
case ada_catch_assert:
return (&catch_assert_breakpoint_ops);
break;
+ case ada_catch_handlers:
+ return (&catch_handlers_breakpoint_ops);
+ break;
default:
internal_error (__FILE__, __LINE__,
_("unexpected catchpoint kind (%d)"), ex);
being raised with the exception that the user wants to catch. This
assumes that this condition is used when the inferior just triggered
an exception catchpoint.
+ EX: the type of catchpoints used for catching Ada exceptions.
The string returned is a newly allocated string that needs to be
deallocated later. */
static char *
-ada_exception_catchpoint_cond_string (const char *excep_string)
+ada_exception_catchpoint_cond_string (const char *excep_string,
+ enum ada_exception_catchpoint_kind ex)
{
int i;
+ bool is_standard_exc = false;
+ const char *actual_exc_expr;
+ char *ref_exc_expr;
+
+ if (ex == ada_catch_handlers)
+ {
+ /* For exception handlers catchpoints, the condition string does
+ not use the same parameter as for the other exceptions. */
+ actual_exc_expr = ("long_integer (GNAT_GCC_exception_Access"
+ "(gcc_exception).all.occurrence.id)");
+ }
+ else
+ actual_exc_expr = "long_integer (e)";
/* The standard exceptions are a special case. They are defined in
runtime units that have been compiled without debugging info; if
{
if (strcmp (standard_exc [i], excep_string) == 0)
{
- return xstrprintf ("long_integer (e) = long_integer (&standard.%s)",
- excep_string);
+ is_standard_exc = true;
+ break;
}
}
- return xstrprintf ("long_integer (e) = long_integer (&%s)", excep_string);
+
+ if (is_standard_exc)
+ ref_exc_expr = xstrprintf ("long_integer (&standard.%s)", excep_string);
+ else
+ ref_exc_expr = xstrprintf ("long_integer (&%s)", excep_string);
+
+ char *result = xstrprintf ("%s = %s", actual_exc_expr, ref_exc_expr);
+ xfree (ref_exc_expr);
+ return result;
}
/* Return the symtab_and_line that should be used to insert an exception
create_ada_exception_catchpoint (struct gdbarch *gdbarch,
enum ada_exception_catchpoint_kind ex_kind,
char *excep_string,
- char *cond_string,
+ const std::string &cond_string,
int tempflag,
int disabled,
int from_tty)
init_ada_exception_breakpoint (c.get (), gdbarch, sal, addr_string,
ops, tempflag, disabled, from_tty);
c->excep_string = excep_string;
- create_excep_cond_exprs (c.get ());
- if (cond_string != NULL)
- set_breakpoint_condition (c.get (), cond_string, from_tty);
+ create_excep_cond_exprs (c.get (), ex_kind);
+ if (!cond_string.empty ())
+ set_breakpoint_condition (c.get (), cond_string.c_str (), from_tty);
install_breakpoint (0, std::move (c), 1);
}
int tempflag;
enum ada_exception_catchpoint_kind ex_kind;
char *excep_string = NULL;
- char *cond_string = NULL;
+ std::string cond_string;
tempflag = get_cmd_context (command) == CATCH_TEMPORARY;
if (!arg)
arg = "";
- catch_ada_exception_command_split (arg, &ex_kind, &excep_string,
- &cond_string);
+ catch_ada_exception_command_split (arg, false, &ex_kind, &excep_string,
+ cond_string);
+ create_ada_exception_catchpoint (gdbarch, ex_kind,
+ excep_string, cond_string,
+ tempflag, 1 /* enabled */,
+ from_tty);
+}
+
+/* Implement the "catch handlers" command. */
+
+static void
+catch_ada_handlers_command (const char *arg_entry, int from_tty,
+ struct cmd_list_element *command)
+{
+ const char *arg = arg_entry;
+ struct gdbarch *gdbarch = get_current_arch ();
+ int tempflag;
+ enum ada_exception_catchpoint_kind ex_kind;
+ char *excep_string = NULL;
+ std::string cond_string;
+
+ tempflag = get_cmd_context (command) == CATCH_TEMPORARY;
+
+ if (!arg)
+ arg = "";
+ catch_ada_exception_command_split (arg, true, &ex_kind, &excep_string,
+ cond_string);
create_ada_exception_catchpoint (gdbarch, ex_kind,
excep_string, cond_string,
tempflag, 1 /* enabled */,
(the memory needs to be deallocated after use). */
static void
-catch_ada_assert_command_split (const char *args, char **cond_string)
+catch_ada_assert_command_split (const char *args, std::string &cond_string)
{
args = skip_spaces (args);
args = skip_spaces (args);
if (args[0] == '\0')
error (_("condition missing after `if' keyword"));
- *cond_string = xstrdup (args);
+ cond_string.assign (args);
}
/* Otherwise, there should be no other argument at the end of
const char *arg = arg_entry;
struct gdbarch *gdbarch = get_current_arch ();
int tempflag;
- char *cond_string = NULL;
+ std::string cond_string;
tempflag = get_cmd_context (command) == CATCH_TEMPORARY;
if (!arg)
arg = "";
- catch_ada_assert_command_split (arg, &cond_string);
+ catch_ada_assert_command_split (arg, cond_string);
create_ada_exception_catchpoint (gdbarch, ada_catch_assert,
NULL, cond_string,
tempflag, 1 /* enabled */,
ada_primitive_type_natural,
ada_primitive_type_positive,
ada_primitive_type_system_address,
+ ada_primitive_type_storage_offset,
nr_ada_primitive_types
};
TYPE_NAME (lai->primitive_type_vector [ada_primitive_type_system_address])
= "system__address";
+ /* Create the equivalent of the System.Storage_Elements.Storage_Offset
+ type. This is a signed integral type whose size is the same as
+ the size of addresses. */
+ {
+ unsigned int addr_length = TYPE_LENGTH
+ (lai->primitive_type_vector [ada_primitive_type_system_address]);
+
+ lai->primitive_type_vector [ada_primitive_type_storage_offset]
+ = arch_integer_type (gdbarch, addr_length * HOST_CHAR_BIT, 0,
+ "storage_offset");
+ }
+
lai->bool_type_symbol = NULL;
lai->bool_type_default = builtin->builtin_bool;
}
static bool
do_wild_match (const char *symbol_search_name,
const lookup_name_info &lookup_name,
- completion_match *match)
+ completion_match_result *comp_match_res)
{
return wild_match (symbol_search_name, ada_lookup_name (lookup_name));
}
static bool
do_full_match (const char *symbol_search_name,
const lookup_name_info &lookup_name,
- completion_match *match)
+ completion_match_result *comp_match_res)
{
return full_match (symbol_search_name, ada_lookup_name (lookup_name));
}
static bool
ada_symbol_name_matches (const char *symbol_search_name,
const lookup_name_info &lookup_name,
- completion_match *match)
+ completion_match_result *comp_match_res)
{
return lookup_name.ada ().matches (symbol_search_name,
lookup_name.match_type (),
- match);
+ comp_match_res);
+}
+
+/* A name matcher that matches the symbol name exactly, with
+ strcmp. */
+
+static bool
+literal_symbol_name_matcher (const char *symbol_search_name,
+ const lookup_name_info &lookup_name,
+ completion_match_result *comp_match_res)
+{
+ const std::string &name = lookup_name.name ();
+
+ int cmp = (lookup_name.completion_mode ()
+ ? strncmp (symbol_search_name, name.c_str (), name.size ())
+ : strcmp (symbol_search_name, name.c_str ()));
+ if (cmp == 0)
+ {
+ if (comp_match_res != NULL)
+ comp_match_res->set_match (symbol_search_name);
+ return true;
+ }
+ else
+ return false;
}
/* Implement the "la_get_symbol_name_matcher" language_defn method for
static symbol_name_matcher_ftype *
ada_get_symbol_name_matcher (const lookup_name_info &lookup_name)
{
+ if (lookup_name.match_type () == symbol_name_match_type::SEARCH_NAME)
+ return literal_symbol_name_matcher;
+
if (lookup_name.completion_mode ())
return ada_symbol_name_matches;
else
ada_read_var_value, /* la_read_var_value */
NULL, /* Language specific skip_trampoline */
NULL, /* name_of_this */
+ true, /* la_store_sym_names_in_linkage_form_p */
ada_lookup_symbol_nonlocal, /* Looking up non-local symbols. */
basic_lookup_transparent_type, /* lookup_transparent_type */
ada_la_decode, /* Language specific symbol demangler */
ops->print_one = print_one_catch_assert;
ops->print_mention = print_mention_catch_assert;
ops->print_recreate = print_recreate_catch_assert;
+
+ ops = &catch_handlers_breakpoint_ops;
+ *ops = bkpt_breakpoint_ops;
+ ops->allocate_location = allocate_location_catch_handlers;
+ ops->re_set = re_set_catch_handlers;
+ ops->check_status = check_status_catch_handlers;
+ ops->print_it = print_it_catch_handlers;
+ ops->print_one = print_one_catch_handlers;
+ ops->print_mention = print_mention_catch_handlers;
+ ops->print_recreate = print_recreate_catch_handlers;
}
/* This module's 'new_objfile' observer. */
NULL,
CATCH_PERMANENT,
CATCH_TEMPORARY);
+
+ add_catch_command ("handlers", _("\
+Catch Ada exceptions, when handled.\n\
+With an argument, catch only exceptions with the given name."),
+ catch_ada_handlers_command,
+ NULL,
+ CATCH_PERMANENT,
+ CATCH_TEMPORARY);
add_catch_command ("assert", _("\
Catch failed Ada assertions, when raised.\n\
With an argument, catch only exceptions with the given name."),
CATCH_TEMPORARY);
varsize_limit = 65536;
+ add_setshow_uinteger_cmd ("varsize-limit", class_support,
+ &varsize_limit, _("\
+Set the maximum number of bytes allowed in a variable-size object."), _("\
+Show the maximum number of bytes allowed in a variable-size object."), _("\
+Attempts to access an object whose size is not a compile-time constant\n\
+and exceeds this limit will cause an error."),
+ NULL, NULL, &setlist, &showlist);
add_info ("exceptions", info_exceptions_command,
_("\
DWARF attribute."),
NULL, NULL, &maint_set_ada_cmdlist, &maint_show_ada_cmdlist);
- obstack_init (&symbol_list_obstack);
-
decoded_names_store = htab_create_alloc
(256, htab_hash_string, (int (*)(const void *, const void *)) streq,
NULL, xcalloc, xfree);
/* The ada-lang observers. */
- observer_attach_new_objfile (ada_new_objfile_observer);
- observer_attach_free_objfile (ada_free_objfile_observer);
- observer_attach_inferior_exit (ada_inferior_exit);
+ gdb::observers::new_objfile.attach (ada_new_objfile_observer);
+ gdb::observers::free_objfile.attach (ada_free_objfile_observer);
+ gdb::observers::inferior_exit.attach (ada_inferior_exit);
/* Setup various context-specific data. */
ada_inferior_data
projects / deliverable / binutils-gdb.git / blobdiff