#include "observer.h"
#include "vec.h"
-#ifndef ADA_RETAIN_DOTS
-#define ADA_RETAIN_DOTS 0
-#endif
-
/* Define whether or not the C operator '/' truncates towards zero for
differently signed operands (truncation direction is undefined in C).
Copied from valarith.c. */
static int is_name_suffix (const char *);
-static int is_digits_suffix (const char *str);
-
static int wild_match (const char *, int, const char *);
static struct value *ada_coerce_ref (struct value *);
static void
ada_print_array_index (struct value *index_value, struct ui_file *stream,
- int format, enum val_prettyprint pretty)
+ const struct value_print_options *options)
{
- LA_VALUE_PRINT (index_value, stream, format, pretty);
+ LA_VALUE_PRINT (index_value, stream, options);
fprintf_filtered (stream, " => ");
}
k = 0;
for (p = decoded; *p != '\0'; p += 1)
{
- if (!ADA_RETAIN_DOTS && *p == '.')
+ if (*p == '.')
{
encoding_buffer[k] = encoding_buffer[k + 1] = '_';
k += 2;
if (i < len0)
goto Suppress;
}
- else if (!ADA_RETAIN_DOTS
- && i < len0 - 2 && encoded[i] == '_' && encoded[i + 1] == '_')
+ else if (i < len0 - 2 && encoded[i] == '_' && encoded[i + 1] == '_')
{
/* Replace '__' by '.'. */
decoded[j] = '.';
return 0;
}
-/* Return nonzero if the given string contains only digits.
- The empty string also matches. */
-
-static int
-is_digits_suffix (const char *str)
-{
- while (isdigit (str[0]))
- str++;
- return (str[0] == '\0');
-}
-
/* Return non-zero if the string starting at NAME and ending before
NAME_END contains no capital letters. */
for (j = TYPE_NFIELDS (field_type) - 1; j >= 0; j -= 1)
{
+ /* FIXME pnh 2008/01/26: We check for a field that is
+ NOT wrapped in a struct, since the compiler sometimes
+ generates these for unchecked variant types. Revisit
+ if the compiler changes this practice. */
+ char *v_field_name = TYPE_FIELD_NAME (field_type, j);
disp = 0;
- t = ada_lookup_struct_elt_type (TYPE_FIELD_TYPE (field_type, j),
- name, 0, 1, &disp);
+ if (v_field_name != NULL
+ && field_name_match (v_field_name, name))
+ t = ada_check_typedef (TYPE_FIELD_TYPE (field_type, j));
+ else
+ t = ada_lookup_struct_elt_type (TYPE_FIELD_TYPE (field_type, j),
+ name, 0, 1, &disp);
+
if (t != NULL)
{
if (dispp != NULL)
return NULL;
}
+/* Assuming that VAR_TYPE is the type of a variant part of a record (a union),
+ within a value of type OUTER_TYPE, return true iff VAR_TYPE
+ represents an unchecked union (that is, the variant part of a
+ record that is named in an Unchecked_Union pragma). */
+
+static int
+is_unchecked_variant (struct type *var_type, struct type *outer_type)
+{
+ char *discrim_name = ada_variant_discrim_name (var_type);
+ return (ada_lookup_struct_elt_type (outer_type, discrim_name, 0, 1, NULL)
+ == NULL);
+}
+
+
/* Assuming that VAR_TYPE is the type of a variant part of a record (a union),
within a value of type OUTER_TYPE that is stored in GDB at
OUTER_VALADDR, determine which variant clause (field number in VAR_TYPE,
TYPE_CODE (type) = TYPE_CODE_STRUCT;
TYPE_NFIELDS (type) = 0;
TYPE_FIELDS (type) = NULL;
+ INIT_CPLUS_SPECIFIC (type);
TYPE_NAME (type) = "<empty>";
TYPE_TAG_NAME (type) = NULL;
TYPE_LENGTH (type) = 0;
}
/* We handle the variant part, if any, at the end because of certain
- odd cases in which it is re-ordered so as NOT the last field of
+ odd cases in which it is re-ordered so as NOT to be the last field of
the record. This can happen in the presence of representation
clauses. */
if (variant_field >= 0)
union type. Any necessary discriminants' values should be in DVAL,
a record value. That is, this routine selects the appropriate
branch of the union at ADDR according to the discriminant value
- indicated in the union's type name. */
+ indicated in the union's type name. Returns VAR_TYPE0 itself if
+ it represents a variant subject to a pragma Unchecked_Union. */
static struct type *
to_fixed_variant_branch_type (struct type *var_type0, const gdb_byte *valaddr,
if (templ_type != NULL)
var_type = templ_type;
+ if (is_unchecked_variant (var_type, value_type (dval)))
+ return var_type0;
which =
ada_which_variant_applies (var_type,
value_type (dval), value_contents (dval));
if (real_type != NULL)
return to_fixed_record_type (real_type, valaddr, address, NULL);
}
+
+ /* Check to see if there is a parallel ___XVZ variable.
+ If there is, then it provides the actual size of our type. */
+ else if (ada_type_name (fixed_record_type) != NULL)
+ {
+ char *name = ada_type_name (fixed_record_type);
+ char *xvz_name = alloca (strlen (name) + 7 /* "___XVZ\0" */);
+ int xvz_found = 0;
+ LONGEST size;
+
+ sprintf (xvz_name, "%s___XVZ", name);
+ size = get_int_var_value (xvz_name, &xvz_found);
+ if (xvz_found && TYPE_LENGTH (fixed_record_type) != size)
+ {
+ fixed_record_type = copy_type (fixed_record_type);
+ TYPE_LENGTH (fixed_record_type) = size;
+
+ /* The FIXED_RECORD_TYPE may have be a stub. We have
+ observed this when the debugging info is STABS, and
+ apparently it is something that is hard to fix.
+
+ In practice, we don't need the actual type definition
+ at all, because the presence of the XVZ variable allows us
+ to assume that there must be a XVS type as well, which we
+ should be able to use later, when we need the actual type
+ definition.
+
+ In the meantime, pretend that the "fixed" type we are
+ returning is NOT a stub, because this can cause trouble
+ when using this type to create new types targeting it.
+ Indeed, the associated creation routines often check
+ whether the target type is a stub and will try to replace
+ it, thus using a type with the wrong size. This, in turn,
+ might cause the new type to have the wrong size too.
+ Consider the case of an array, for instance, where the size
+ of the array is computed from the number of elements in
+ our array multiplied by the size of its element. */
+ TYPE_STUB (fixed_record_type) = 0;
+ }
+ }
return fixed_record_type;
}
case TYPE_CODE_ARRAY:
case OP_ATR_SIZE:
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ type = value_type (arg1);
+
+ /* If the argument is a reference, then dereference its type, since
+ the user is really asking for the size of the actual object,
+ not the size of the pointer. */
+ if (TYPE_CODE (type) == TYPE_CODE_REF)
+ type = TYPE_TARGET_TYPE (type);
+
if (noside == EVAL_SKIP)
goto nosideret;
else if (noside == EVAL_AVOID_SIDE_EFFECTS)
return value_zero (builtin_type_int32, not_lval);
else
return value_from_longest (builtin_type_int32,
- TARGET_CHAR_BIT
- * TYPE_LENGTH (value_type (arg1)));
+ TARGET_CHAR_BIT * TYPE_LENGTH (type));
case OP_ATR_VAL:
evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
return arg1;
case UNOP_IND:
- if (expect_type && TYPE_CODE (expect_type) == TYPE_CODE_PTR)
- expect_type = TYPE_TARGET_TYPE (ada_check_typedef (expect_type));
- arg1 = evaluate_subexp (expect_type, exp, pos, noside);
+ arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
type = ada_check_typedef (value_type (arg1));
return value_zero (type, lval_memory);
}
else if (TYPE_CODE (type) == TYPE_CODE_INT)
- /* GDB allows dereferencing an int. */
- return value_zero (builtin_type (exp->gdbarch)->builtin_int,
- lval_memory);
+ {
+ /* GDB allows dereferencing an int. */
+ if (expect_type == NULL)
+ return value_zero (builtin_type (exp->gdbarch)->builtin_int,
+ lval_memory);
+ else
+ {
+ expect_type =
+ to_static_fixed_type (ada_aligned_type (expect_type));
+ return value_zero (expect_type, lval_memory);
+ }
+ }
else
error (_("Attempt to take contents of a non-pointer value."));
}
arg1 = ada_coerce_ref (arg1); /* FIXME: What is this for?? */
type = ada_check_typedef (value_type (arg1));
+ if (TYPE_CODE (type) == TYPE_CODE_INT && expect_type != NULL)
+ /* GDB allows dereferencing an int. We give it the expected
+ type (which will be set in the case of a coercion or
+ qualification). */
+ return ada_value_ind (value_cast (lookup_pointer_type (expect_type),
+ arg1));
+
if (ada_is_array_descriptor_type (type))
/* GDB allows dereferencing GNAT array descriptors. */
return ada_coerce_to_simple_array (arg1);
- else if (TYPE_CODE (type) == TYPE_CODE_INT)
- /* GDB allows dereferencing an int. */
- return value_at_lazy (builtin_type (exp->gdbarch)->builtin_int,
- (CORE_ADDR) value_as_address (arg1));
else
return ada_value_ind (arg1);
ULONGEST
ada_modulus (struct type * type)
{
- return (ULONGEST) TYPE_HIGH_BOUND (type) + 1;
+ return (ULONGEST) (unsigned int) TYPE_HIGH_BOUND (type) + 1;
}
\f
ex_catch_assert
};
+/* Ada's standard exceptions. */
+
+static char *standard_exc[] = {
+ "constraint_error",
+ "program_error",
+ "storage_error",
+ "tasking_error"
+};
+
typedef CORE_ADDR (ada_unhandled_exception_name_addr_ftype) (void);
/* A structure that describes how to support exception catchpoints
/* Find the first frame that contains debugging information and that is not
part of the Ada run-time, starting from FI and moving upward. */
-static void
+void
ada_find_printable_frame (struct frame_info *fi)
{
for (; fi != NULL; fi = get_prev_frame (fi))
print_one_exception (enum exception_catchpoint_kind ex,
struct breakpoint *b, CORE_ADDR *last_addr)
{
- if (addressprint)
+ struct value_print_options opts;
+
+ get_user_print_options (&opts);
+ if (opts.addressprint)
{
annotate_field (4);
ui_out_field_core_addr (uiout, "addr", b->loc->address);
static struct breakpoint_ops catch_exception_breakpoint_ops =
{
+ NULL, /* insert */
+ NULL, /* remove */
+ NULL, /* breakpoint_hit */
print_it_catch_exception,
print_one_catch_exception,
print_mention_catch_exception
}
static struct breakpoint_ops catch_exception_unhandled_breakpoint_ops = {
+ NULL, /* insert */
+ NULL, /* remove */
+ NULL, /* breakpoint_hit */
print_it_catch_exception_unhandled,
print_one_catch_exception_unhandled,
print_mention_catch_exception_unhandled
}
static struct breakpoint_ops catch_assert_breakpoint_ops = {
+ NULL, /* insert */
+ NULL, /* remove */
+ NULL, /* breakpoint_hit */
print_it_catch_assert,
print_one_catch_assert,
print_mention_catch_assert
static char *
ada_exception_catchpoint_cond_string (const char *exp_string)
{
+ int i;
+
+ /* The standard exceptions are a special case. They are defined in
+ runtime units that have been compiled without debugging info; if
+ EXP_STRING is the not-fully-qualified name of a standard
+ exception (e.g. "constraint_error") then, during the evaluation
+ of the condition expression, the symbol lookup on this name would
+ *not* return this standard exception. The catchpoint condition
+ may then be set only on user-defined exceptions which have the
+ same not-fully-qualified name (e.g. my_package.constraint_error).
+
+ To avoid this unexcepted behavior, these standard exceptions are
+ systematically prefixed by "standard". This means that "catch
+ exception constraint_error" is rewritten into "catch exception
+ standard.constraint_error".
+
+ If an exception named contraint_error is defined in another package of
+ the inferior program, then the only way to specify this exception as a
+ breakpoint condition is to use its fully-qualified named:
+ e.g. my_package.constraint_error. */
+
+ for (i = 0; i < sizeof (standard_exc) / sizeof (char *); i++)
+ {
+ if (strcmp (standard_exc [i], exp_string) == 0)
+ {
+ return xstrprintf ("long_integer (e) = long_integer (&standard.%s)",
+ exp_string);
+ }
+ }
return xstrprintf ("long_integer (e) = long_integer (&%s)", exp_string);
}
projects / binutils-gdb.git / blobdiff