+2020-11-04 Tom Tromey <tromey@adacore.com>
+
+ * dwarf2/read.c (recognize_bound_expression)
+ (quirk_ada_thick_pointer): New functions.
+ (read_array_type): Call quirk_ada_thick_pointer.
+ (set_die_type): Add "skip_data_location" parameter.
+ (quirk_ada_thick_pointer): New function.
+ (process_structure_scope): Call quirk_ada_thick_pointer.
+ * ada-lang.c (ada_is_unconstrained_packed_array_type)
+ (decode_packed_array_bitsize): Handle thick pointers without
+ parallel types.
+ (ada_is_gnat_encoded_packed_array_type): Rename from
+ ada_is_packed_array_type.
+ (ada_is_constrained_packed_array_type): Update.
+ * ada-valprint.c (ada_val_print_gnat_array): Remove.
+ (ada_value_print_1): Use ada_get_decoded_value.
+
2020-11-04 Tom Tromey <tromey@adacore.com>
* ada-lang.c (recursively_update_array_bitsize): New function.
static struct value *decode_constrained_packed_array (struct value *);
-static int ada_is_packed_array_type (struct type *);
-
static int ada_is_unconstrained_packed_array_type (struct type *);
static struct value *value_subscript_packed (struct value *, int,
/* Non-zero iff TYPE represents a standard GNAT packed-array type. */
static int
-ada_is_packed_array_type (struct type *type)
+ada_is_gnat_encoded_packed_array_type (struct type *type)
{
if (type == NULL)
return 0;
int
ada_is_constrained_packed_array_type (struct type *type)
{
- return ada_is_packed_array_type (type)
+ return ada_is_gnat_encoded_packed_array_type (type)
&& !ada_is_array_descriptor_type (type);
}
static int
ada_is_unconstrained_packed_array_type (struct type *type)
{
- return ada_is_packed_array_type (type)
- && ada_is_array_descriptor_type (type);
+ if (!ada_is_array_descriptor_type (type))
+ return 0;
+
+ if (ada_is_gnat_encoded_packed_array_type (type))
+ return 1;
+
+ /* If we saw GNAT encodings, then the above code is sufficient.
+ However, with minimal encodings, we will just have a thick
+ pointer instead. */
+ if (is_thick_pntr (type))
+ {
+ type = desc_base_type (type);
+ /* The structure's first field is a pointer to an array, so this
+ fetches the array type. */
+ type = TYPE_TARGET_TYPE (type->field (0).type ());
+ /* Now we can see if the array elements are packed. */
+ return TYPE_FIELD_BITSIZE (type, 0) > 0;
+ }
+
+ return 0;
}
/* Given that TYPE encodes a packed array type (constrained or unconstrained),
return 0;
tail = strstr (raw_name, "___XP");
- gdb_assert (tail != NULL);
+ if (tail == nullptr)
+ {
+ gdb_assert (is_thick_pntr (type));
+ /* The structure's first field is a pointer to an array, so this
+ fetches the array type. */
+ type = TYPE_TARGET_TYPE (type->field (0).type ());
+ /* Now we can see if the array elements are packed. */
+ return TYPE_FIELD_BITSIZE (type, 0);
+ }
if (sscanf (tail + sizeof ("___XP") - 1, "%ld", &bits) != 1)
{
eltlen, options);
}
-/* Implement Ada val_print-ing for GNAT arrays (Eg. fat pointers,
- thin pointers, etc). */
-
-static void
-ada_val_print_gnat_array (struct value *val,
- struct ui_file *stream, int recurse,
- const struct value_print_options *options)
-{
- scoped_value_mark free_values;
-
- struct type *type = ada_check_typedef (value_type (val));
-
- /* If this is a reference, coerce it now. This helps taking care
- of the case where ADDRESS is meaningless because original_value
- was not an lval. */
- val = coerce_ref (val);
- if (type->code () == TYPE_CODE_TYPEDEF) /* array access type. */
- val = ada_coerce_to_simple_array_ptr (val);
- else
- val = ada_coerce_to_simple_array (val);
- if (val == NULL)
- {
- gdb_assert (type->code () == TYPE_CODE_TYPEDEF);
- fprintf_filtered (stream, "0x0");
- }
- else
- common_val_print (val, stream, recurse, options,
- language_def (language_ada));
-}
-
/* Implement Ada value_print'ing for the case where TYPE is a
TYPE_CODE_PTR. */
|| (ada_is_constrained_packed_array_type (type)
&& type->code () != TYPE_CODE_PTR))
{
- ada_val_print_gnat_array (val, stream, recurse, options);
- return;
+ /* If this is a reference, coerce it now. This helps taking
+ care of the case where ADDRESS is meaningless because
+ original_value was not an lval. */
+ val = coerce_ref (val);
+ val = ada_get_decoded_value (val);
+ if (val == nullptr)
+ {
+ gdb_assert (type->code () == TYPE_CODE_TYPEDEF);
+ fprintf_filtered (stream, "0x0");
+ return;
+ }
}
+ else
+ val = ada_to_fixed_value (val);
- val = ada_to_fixed_value (val);
type = value_type (val);
struct type *saved_type = type;
const gdb_byte **bytes,
struct dwarf2_locexpr_baton **baton);
+static struct type *read_subrange_index_type (struct die_info *die,
+ struct dwarf2_cu *cu);
+
static struct type *die_type (struct die_info *, struct dwarf2_cu *);
static int need_gnat_info (struct dwarf2_cu *);
enum language pretend_language);
static struct type *set_die_type (struct die_info *, struct type *,
- struct dwarf2_cu *);
+ struct dwarf2_cu *, bool = false);
static void create_all_comp_units (dwarf2_per_objfile *per_objfile);
smash_to_methodptr_type (type, new_type);
}
+/* While some versions of GCC will generate complicated DWARF for an
+ array (see quirk_ada_thick_pointer), more recent versions were
+ modified to emit an explicit thick pointer structure. However, in
+ this case, the array still has DWARF expressions for its ranges,
+ and these must be ignored. */
+
+static void
+quirk_ada_thick_pointer_struct (struct die_info *die, struct dwarf2_cu *cu,
+ struct type *type)
+{
+ gdb_assert (cu->language == language_ada);
+
+ /* Check for a structure with two children. */
+ if (type->code () != TYPE_CODE_STRUCT || type->num_fields () != 2)
+ return;
+
+ /* Check for P_ARRAY and P_BOUNDS members. */
+ if (TYPE_FIELD_NAME (type, 0) == NULL
+ || strcmp (TYPE_FIELD_NAME (type, 0), "P_ARRAY") != 0
+ || TYPE_FIELD_NAME (type, 1) == NULL
+ || strcmp (TYPE_FIELD_NAME (type, 1), "P_BOUNDS") != 0)
+ return;
+
+ /* Make sure we're looking at a pointer to an array. */
+ if (type->field (0).type ()->code () != TYPE_CODE_PTR)
+ return;
+ struct type *ary_type = TYPE_TARGET_TYPE (type->field (0).type ());
+
+ while (ary_type->code () == TYPE_CODE_ARRAY)
+ {
+ /* The Ada code already knows how to handle these types, so all
+ that we need to do is turn the bounds into static bounds. */
+ struct type *index_type = ary_type->index_type ();
+
+ index_type->bounds ()->low.set_const_val (1);
+ index_type->bounds ()->high.set_const_val (0);
+
+ /* Handle multi-dimensional arrays. */
+ ary_type = TYPE_TARGET_TYPE (ary_type);
+ }
+}
+
/* If the DIE has a DW_AT_alignment attribute, return its value, doing
appropriate error checking and issuing complaints if there is a
problem. */
quirk_gcc_member_function_pointer (type, objfile);
if (cu->language == language_rust && die->tag == DW_TAG_union_type)
cu->rust_unions.push_back (type);
+ else if (cu->language == language_ada)
+ quirk_ada_thick_pointer_struct (die, cu, type);
/* NOTE: carlton/2004-03-16: GCC 3.4 (or at least one of its
snapshots) has been known to create a die giving a declaration
new_symbol (die, this_type, cu);
}
+/* Helper function for quirk_ada_thick_pointer that examines a bounds
+ expression for an index type and finds the corresponding field
+ offset in the hidden "P_BOUNDS" structure. Returns true on success
+ and updates *FIELD, false if it fails to recognize an
+ expression. */
+
+static bool
+recognize_bound_expression (struct die_info *die, enum dwarf_attribute name,
+ int *bounds_offset, struct field *field,
+ struct dwarf2_cu *cu)
+{
+ struct attribute *attr = dwarf2_attr (die, name, cu);
+ if (attr == nullptr || !attr->form_is_block ())
+ return false;
+
+ const struct dwarf_block *block = attr->as_block ();
+ const gdb_byte *start = block->data;
+ const gdb_byte *end = block->data + block->size;
+
+ /* The expression to recognize generally looks like:
+
+ (DW_OP_push_object_address; DW_OP_plus_uconst: 8; DW_OP_deref;
+ DW_OP_plus_uconst: 4; DW_OP_deref_size: 4)
+
+ However, the second "plus_uconst" may be missing:
+
+ (DW_OP_push_object_address; DW_OP_plus_uconst: 8; DW_OP_deref;
+ DW_OP_deref_size: 4)
+
+ This happens when the field is at the start of the structure.
+
+ Also, the final deref may not be sized:
+
+ (DW_OP_push_object_address; DW_OP_plus_uconst: 4; DW_OP_deref;
+ DW_OP_deref)
+
+ This happens when the size of the index type happens to be the
+ same as the architecture's word size. This can occur with or
+ without the second plus_uconst. */
+
+ if (end - start < 2)
+ return false;
+ if (*start++ != DW_OP_push_object_address)
+ return false;
+ if (*start++ != DW_OP_plus_uconst)
+ return false;
+
+ uint64_t this_bound_off;
+ start = gdb_read_uleb128 (start, end, &this_bound_off);
+ if (start == nullptr || (int) this_bound_off != this_bound_off)
+ return false;
+ /* Update *BOUNDS_OFFSET if needed, or alternatively verify that it
+ is consistent among all bounds. */
+ if (*bounds_offset == -1)
+ *bounds_offset = this_bound_off;
+ else if (*bounds_offset != this_bound_off)
+ return false;
+
+ if (start == end || *start++ != DW_OP_deref)
+ return false;
+
+ int offset = 0;
+ if (start ==end)
+ return false;
+ else if (*start == DW_OP_deref_size || *start == DW_OP_deref)
+ {
+ /* This means an offset of 0. */
+ }
+ else if (*start++ != DW_OP_plus_uconst)
+ return false;
+ else
+ {
+ /* The size is the parameter to DW_OP_plus_uconst. */
+ uint64_t val;
+ start = gdb_read_uleb128 (start, end, &val);
+ if (start == nullptr)
+ return false;
+ if ((int) val != val)
+ return false;
+ offset = val;
+ }
+
+ if (start == end)
+ return false;
+
+ uint64_t size;
+ if (*start == DW_OP_deref_size)
+ {
+ start = gdb_read_uleb128 (start + 1, end, &size);
+ if (start == nullptr)
+ return false;
+ }
+ else if (*start == DW_OP_deref)
+ {
+ size = cu->header.addr_size;
+ ++start;
+ }
+ else
+ return false;
+
+ SET_FIELD_BITPOS (*field, 8 * offset);
+ if (size != TYPE_LENGTH (field->type ()))
+ FIELD_BITSIZE (*field) = 8 * size;
+
+ return true;
+}
+
+/* With -fgnat-encodings=minimal, gcc will emit some unusual DWARF for
+ some kinds of Ada arrays:
+
+ <1><11db>: Abbrev Number: 7 (DW_TAG_array_type)
+ <11dc> DW_AT_name : (indirect string, offset: 0x1bb8): string
+ <11e0> DW_AT_data_location: 2 byte block: 97 6
+ (DW_OP_push_object_address; DW_OP_deref)
+ <11e3> DW_AT_type : <0x1173>
+ <11e7> DW_AT_sibling : <0x1201>
+ <2><11eb>: Abbrev Number: 8 (DW_TAG_subrange_type)
+ <11ec> DW_AT_type : <0x1206>
+ <11f0> DW_AT_lower_bound : 6 byte block: 97 23 8 6 94 4
+ (DW_OP_push_object_address; DW_OP_plus_uconst: 8; DW_OP_deref;
+ DW_OP_deref_size: 4)
+ <11f7> DW_AT_upper_bound : 8 byte block: 97 23 8 6 23 4 94 4
+ (DW_OP_push_object_address; DW_OP_plus_uconst: 8; DW_OP_deref;
+ DW_OP_plus_uconst: 4; DW_OP_deref_size: 4)
+
+ This actually represents a "thick pointer", which is a structure
+ with two elements: one that is a pointer to the array data, and one
+ that is a pointer to another structure; this second structure holds
+ the array bounds.
+
+ This returns a new type on success, or nullptr if this didn't
+ recognize the type. */
+
+static struct type *
+quirk_ada_thick_pointer (struct die_info *die, struct dwarf2_cu *cu,
+ struct type *type)
+{
+ struct attribute *attr = dwarf2_attr (die, DW_AT_data_location, cu);
+ /* So far we've only seen this with block form. */
+ if (attr == nullptr || !attr->form_is_block ())
+ return nullptr;
+
+ /* Note that this will fail if the structure layout is changed by
+ the compiler. However, we have no good way to recognize some
+ other layout, because we don't know what expression the compiler
+ might choose to emit should this happen. */
+ struct dwarf_block *blk = attr->as_block ();
+ if (blk->size != 2
+ || blk->data[0] != DW_OP_push_object_address
+ || blk->data[1] != DW_OP_deref)
+ return nullptr;
+
+ int bounds_offset = -1;
+ int max_align = -1;
+ std::vector<struct field> range_fields;
+ for (struct die_info *child_die = die->child;
+ child_die;
+ child_die = child_die->sibling)
+ {
+ if (child_die->tag == DW_TAG_subrange_type)
+ {
+ struct type *underlying = read_subrange_index_type (child_die, cu);
+
+ int this_align = type_align (underlying);
+ if (this_align > max_align)
+ max_align = this_align;
+
+ range_fields.emplace_back ();
+ range_fields.emplace_back ();
+
+ struct field &lower = range_fields[range_fields.size () - 2];
+ struct field &upper = range_fields[range_fields.size () - 1];
+
+ lower.set_type (underlying);
+ FIELD_ARTIFICIAL (lower) = 1;
+
+ upper.set_type (underlying);
+ FIELD_ARTIFICIAL (upper) = 1;
+
+ if (!recognize_bound_expression (child_die, DW_AT_lower_bound,
+ &bounds_offset, &lower, cu)
+ || !recognize_bound_expression (child_die, DW_AT_upper_bound,
+ &bounds_offset, &upper, cu))
+ return nullptr;
+ }
+ }
+
+ /* This shouldn't really happen, but double-check that we found
+ where the bounds are stored. */
+ if (bounds_offset == -1)
+ return nullptr;
+
+ struct objfile *objfile = cu->per_objfile->objfile;
+ for (int i = 0; i < range_fields.size (); i += 2)
+ {
+ char name[20];
+
+ /* Set the name of each field in the bounds. */
+ xsnprintf (name, sizeof (name), "LB%d", i / 2);
+ FIELD_NAME (range_fields[i]) = objfile->intern (name);
+ xsnprintf (name, sizeof (name), "UB%d", i / 2);
+ FIELD_NAME (range_fields[i + 1]) = objfile->intern (name);
+ }
+
+ struct type *bounds = alloc_type (objfile);
+ bounds->set_code (TYPE_CODE_STRUCT);
+
+ bounds->set_num_fields (range_fields.size ());
+ bounds->set_fields
+ ((struct field *) TYPE_ALLOC (bounds, (bounds->num_fields ()
+ * sizeof (struct field))));
+ memcpy (bounds->fields (), range_fields.data (),
+ bounds->num_fields () * sizeof (struct field));
+
+ int last_fieldno = range_fields.size () - 1;
+ int bounds_size = (TYPE_FIELD_BITPOS (bounds, last_fieldno) / 8
+ + TYPE_LENGTH (bounds->field (last_fieldno).type ()));
+ TYPE_LENGTH (bounds) = align_up (bounds_size, max_align);
+
+ /* Rewrite the existing array type in place. Specifically, we
+ remove any dynamic properties we might have read, and we replace
+ the index types. */
+ struct type *iter = type;
+ for (int i = 0; i < range_fields.size (); i += 2)
+ {
+ gdb_assert (iter->code () == TYPE_CODE_ARRAY);
+ iter->main_type->dyn_prop_list = nullptr;
+ iter->set_index_type
+ (create_static_range_type (NULL, bounds->field (i).type (), 1, 0));
+ iter = TYPE_TARGET_TYPE (iter);
+ }
+
+ struct type *result = alloc_type (objfile);
+ result->set_code (TYPE_CODE_STRUCT);
+
+ result->set_num_fields (2);
+ result->set_fields
+ ((struct field *) TYPE_ZALLOC (result, (result->num_fields ()
+ * sizeof (struct field))));
+
+ /* The names are chosen to coincide with what the compiler does with
+ -fgnat-encodings=all, which the Ada code in gdb already
+ understands. */
+ TYPE_FIELD_NAME (result, 0) = "P_ARRAY";
+ result->field (0).set_type (lookup_pointer_type (type));
+
+ TYPE_FIELD_NAME (result, 1) = "P_BOUNDS";
+ result->field (1).set_type (lookup_pointer_type (bounds));
+ SET_FIELD_BITPOS (result->field (1), 8 * bounds_offset);
+
+ result->set_name (type->name ());
+ TYPE_LENGTH (result) = (TYPE_LENGTH (result->field (0).type ())
+ + TYPE_LENGTH (result->field (1).type ()));
+
+ return result;
+}
+
/* Extract all information from a DW_TAG_array_type DIE and put it in
the DIE's type field. For now, this only handles one dimensional
arrays. */
maybe_set_alignment (cu, die, type);
+ struct type *replacement_type = nullptr;
+ if (cu->language == language_ada)
+ {
+ replacement_type = quirk_ada_thick_pointer (die, cu, type);
+ if (replacement_type != nullptr)
+ type = replacement_type;
+ }
+
/* Install the type in the die. */
- set_die_type (die, type, cu);
+ set_die_type (die, type, cu, replacement_type != nullptr);
/* set_die_type should be already done. */
set_descriptive_type (type, die, cu);
* Make the type as complete as possible before fetching more types. */
static struct type *
-set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu)
+set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu,
+ bool skip_data_location)
{
dwarf2_per_objfile *per_objfile = cu->per_objfile;
struct dwarf2_per_cu_offset_and_type **slot, ofs;
}
/* Read DW_AT_data_location and set in type. */
- attr = dwarf2_attr (die, DW_AT_data_location, cu);
- if (attr_to_dynamic_prop (attr, die, cu, &prop, cu->addr_type ()))
- type->add_dyn_prop (DYN_PROP_DATA_LOCATION, prop);
+ if (!skip_data_location)
+ {
+ attr = dwarf2_attr (die, DW_AT_data_location, cu);
+ if (attr_to_dynamic_prop (attr, die, cu, &prop, cu->addr_type ()))
+ type->add_dyn_prop (DYN_PROP_DATA_LOCATION, prop);
+ }
if (per_objfile->die_type_hash == NULL)
per_objfile->die_type_hash
+2020-11-04 Tom Tromey <tromey@adacore.com>
+
+ * gdb.ada/O2_float_param.exp: Test different -fgnat-encodings
+ values.
+ * gdb.ada/access_to_unbounded_array.exp: Test different
+ -fgnat-encodings values.
+ * gdb.ada/big_packed_array.exp: Test different -fgnat-encodings
+ values.
+ * gdb.ada/arr_enum_idx_w_gap.exp: Test different -fgnat-encodings
+ values.
+ * gdb.ada/array_ptr_renaming.exp: Test different -fgnat-encodings
+ values.
+ * gdb.ada/array_of_variable_length.exp: Test different
+ -fgnat-encodings values.
+ * gdb.ada/arrayparam.exp: Test different -fgnat-encodings values.
+ * gdb.ada/arrayptr.exp: Test different -fgnat-encodings values.
+ * gdb.ada/frame_arg_lang.exp: Revert -fgnat-encodings=minimal
+ change.
+ * gdb.ada/mi_string_access.exp: Test different -fgnat-encodings
+ values.
+ * gdb.ada/mod_from_name.exp: Test different -fgnat-encodings values.
+ * gdb.ada/out_of_line_in_inlined.exp: Test different
+ -fgnat-encodings values.
+ * gdb.ada/packed_array.exp: Test different -fgnat-encodings
+ values.
+ * gdb.ada/pckd_arr_ren.exp: Test different -fgnat-encodings
+ values.
+ * gdb.ada/unc_arr_ptr_in_var_rec.exp: Test different
+ -fgnat-encodings values.
+ * gdb.ada/variant_record_packed_array.exp: Test different
+ -fgnat-encodings values.
+
2020-11-04 Tom Tromey <tromey@adacore.com>
* gdb.ada/enum_idx_packed.exp: Add tests.
standard_ada_testfile foo
-if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug optimize=-O2}] != ""} {
- return -1
-}
+foreach_with_prefix scenario {all minimal} {
+ set flags [list debug \
+ optimize=-O2 \
+ additional_flags=-fgnat-encodings=$scenario]
+
+ if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} {
+ return -1
+ }
-clean_restart ${testfile}
+ clean_restart ${testfile}
-runto "increment"
+ runto "increment"
-gdb_test "frame" \
- "#0\\s+callee\\.increment \\(val(=val@entry)?=99\\.0, msg=\\.\\.\\.\\).*"
+ gdb_test "frame" \
+ "#0\\s+callee\\.increment \\(val(=val@entry)?=99\\.0, msg=\\.\\.\\.\\).*"
+}
standard_ada_testfile foo
-if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } {
- return -1
-}
+foreach_with_prefix scenario {all minimal} {
+ set flags [list debug additional_flags=-fgnat-encodings=$scenario]
+
+ if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} {
+ return -1
+ }
-clean_restart ${testfile}
+ clean_restart ${testfile}
-set bp_location [gdb_get_line_number "BREAK" ${testdir}/foo.adb]
-runto "foo.adb:$bp_location"
+ set bp_location [gdb_get_line_number "BREAK" ${testdir}/foo.adb]
+ runto "foo.adb:$bp_location"
-gdb_test "print Aos(1)" " = \\(foo.string_access\\) $hex"
-gdb_test "print Aos(2)" " = \\(foo.string_access\\) $hex"
+ gdb_test "print Aos(1)" " = \\(foo.string_access\\) $hex"
+ gdb_test "print Aos(2)" " = \\(foo.string_access\\) $hex"
+}
standard_ada_testfile foo_q418_043
-if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } {
- return -1
-}
+foreach_with_prefix scenario {all minimal} {
+ set flags [list debug additional_flags=-fgnat-encodings=$scenario]
-clean_restart ${testfile}
+ if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} {
+ return -1
+ }
-set bp_location [gdb_get_line_number "BREAK" ${testdir}/foo_q418_043.adb]
-if ![runto "foo_q418_043.adb:$bp_location" ] then {
- perror "Couldn't run ${testfile}"
- return
-}
+ clean_restart ${testfile}
-gdb_test "print A" \
- " = \\(42, 42\\)"
+ set bp_location [gdb_get_line_number "BREAK" ${testdir}/foo_q418_043.adb]
+ if ![runto "foo_q418_043.adb:$bp_location" ] then {
+ perror "Couldn't run ${testfile}"
+ return
+ }
+
+ gdb_test "print A" \
+ " = \\(42, 42\\)"
+}
standard_ada_testfile foo
-if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } {
- return -1
+foreach_with_prefix scenario {all minimal} {
+ set flags [list debug additional_flags=-fgnat-encodings=$scenario]
+
+ if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} {
+ return -1
+ }
+
+ clean_restart ${testfile}
+
+ set bp_location [gdb_get_line_number "BREAK" ${testdir}/foo.adb]
+ runto "foo.adb:$bp_location"
+
+ # Pck.A is an array that embeds elements with variable size so compilers will
+ # emit DWARF attributes such as DW_AT_byte_stride to tell GDB how to fetch
+ # individual elements. Array stride is also a way to describe packed arrays:
+ # make sure we do not consider Pck.A as a packed array.
+ gdb_test "ptype pck.a" "array \\(1 \\.\\. 2\\) of pck\\.r_type"
+
+ # Make sure this also works with a type from a fully evaluated value. During
+ # evaluation, dynamic types can be "resolved" so GDB internals could "forget"
+ # that elements have variable size. Fortunately, type resolution of array
+ # elements happens only when processing individual elements (i.e. the resolved
+ # array type is still associated to the dynamic element type), so the following
+ # is supposed to work.
+ gdb_test "print pck.a" \
+ "= \\(\\(l => 0, s => \"\"\\), \\(l => 2, s => \"ab\"\\)\\)"
+ gdb_test "ptype $"\
+ "array \\(1 \\.\\. 2\\) of pck\\.r_type"
}
-
-clean_restart ${testfile}
-
-set bp_location [gdb_get_line_number "BREAK" ${testdir}/foo.adb]
-runto "foo.adb:$bp_location"
-
-# Pck.A is an array that embeds elements with variable size so compilers will
-# emit DWARF attributes such as DW_AT_byte_stride to tell GDB how to fetch
-# individual elements. Array stride is also a way to describe packed arrays:
-# make sure we do not consider Pck.A as a packed array.
-gdb_test "ptype pck.a" "array \\(1 \\.\\. 2\\) of pck\\.r_type"
-
-# Make sure this also works with a type from a fully evaluated value. During
-# evaluation, dynamic types can be "resolved" so GDB internals could "forget"
-# that elements have variable size. Fortunately, type resolution of array
-# elements happens only when processing individual elements (i.e. the resolved
-# array type is still associated to the dynamic element type), so the following
-# is supposed to work.
-gdb_test "print pck.a" \
- "= \\(\\(l => 0, s => \"\"\\), \\(l => 2, s => \"ab\"\\)\\)"
-gdb_test "ptype $"\
- "array \\(1 \\.\\. 2\\) of pck\\.r_type"
standard_ada_testfile foo
-if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } {
- return -1
-}
+foreach_with_prefix scenario {all minimal} {
+ set flags [list debug additional_flags=-fgnat-encodings=$scenario]
+
+ if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} {
+ return -1
+ }
-clean_restart ${testfile}
+ clean_restart ${testfile}
-set bp_location [gdb_get_line_number "BREAK" ${testdir}/foo.adb]
-runto "foo.adb:$bp_location"
+ set bp_location [gdb_get_line_number "BREAK" ${testdir}/foo.adb]
+ runto "foo.adb:$bp_location"
-gdb_test "print nt" " = \\(10, 20\\)"
-gdb_test "print nt(1)" " = 10"
+ gdb_test "print nt" " = \\(10, 20\\)"
+ gdb_test "print nt(1)" " = 10"
-# Accesses to arrays and unconstrained arrays have the same runtime
-# representation with GNAT (fat pointers). In this case, GDB "forgets" that
-# it's dealing with an access and prints directly the array contents. This
-# should be fixed some day.
-setup_kfail "gdb/25883" *-*-*
-gdb_test "print ntp" " = \\(access pack\\.table_type\\) $hex.*"
-gdb_test "print ntp.all" " = \\(3 => 30, 40\\)"
-gdb_test "print ntp(3)" " = 30"
+ # Accesses to arrays and unconstrained arrays have the same runtime
+ # representation with GNAT (fat pointers). In this case, GDB "forgets" that
+ # it's dealing with an access and prints directly the array contents. This
+ # should be fixed some day.
+ setup_kfail "gdb/25883" *-*-*
+ gdb_test "print ntp" " = \\(access pack\\.table_type\\) $hex.*"
+ gdb_test "print ntp.all" " = \\(3 => 30, 40\\)"
+ gdb_test "print ntp(3)" " = 30"
+}
standard_ada_testfile foo
-if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } {
- return -1
-}
+# Note we don't test the "none" (no -fgnat-encodings option) scenario
+# here, because "all" and "minimal" cover the cases, and this way we
+# don't have to update the test when gnat changes its default.
+foreach_with_prefix scenario {all minimal} {
+ set flags [list debug additional_flags=-fgnat-encodings=$scenario]
-clean_restart ${testfile}
+ if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} {
+ return -1
+ }
-set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb]
-runto "foo.adb:$bp_location"
+ clean_restart ${testfile}
-# Verify that a call to a function that takes an array as a parameter
-# works without problem.
+ set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb]
+ runto "foo.adb:$bp_location"
-gdb_test "print call_me(\"bonjour\")" \
- "= void"
+ # Verify that a call to a function that takes an array as a parameter
+ # works without problem.
-# Verify that the array was passed properly by checking the global
-# variables that Call_Me sets as side-effects. Use the package name to avoid
-# name clash with debug info of system libraries.
+ gdb_test "print call_me(\"bonjour\")" \
+ "= void"
-gdb_test "print pck.first" \
- "= 98 'b'" \
- "print first after function call"
+ # Verify that the array was passed properly by checking the global
+ # variables that Call_Me sets as side-effects. Use the package name to avoid
+ # name clash with debug info of system libraries.
-gdb_test "print pck.last" \
- "= 114 'r'" \
- "print last after function call"
+ gdb_test "print pck.first" \
+ "= 98 'b'" \
+ "print first after function call"
-gdb_test "print pck.length" \
- "= 7" \
- "print length after function call"
+ gdb_test "print pck.last" \
+ "= 114 'r'" \
+ "print last after function call"
+ gdb_test "print pck.length" \
+ "= 7" \
+ "print length after function call"
+}
standard_ada_testfile foo
-if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } {
- return -1
-}
+foreach_with_prefix scenario {all minimal} {
+ set flags [list debug additional_flags=-fgnat-encodings=$scenario]
+
+ if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} {
+ return -1
+ }
-clean_restart ${testfile}
+ clean_restart ${testfile}
-set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb]
-if ![runto "foo.adb:$bp_location" ] then {
- perror "Couldn't run ${testfile}"
- return
-}
+ set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb]
+ if ![runto "foo.adb:$bp_location" ] then {
+ perror "Couldn't run ${testfile}"
+ return
+ }
-gdb_test "print string_p" \
- "= \\(foo\\.string_access\\) 0x\[0-9a-zA-Z\]+"
+ gdb_test "print string_p" \
+ "= \\(foo\\.string_access\\) 0x\[0-9a-zA-Z\]+"
-gdb_test "print string_p(3..4)" "= \"ll\""
+ gdb_test "print string_p(3..4)" "= \"ll\""
-gdb_test "print null_string" "= \\(foo\\.string_access\\) 0x0"
+ gdb_test "print null_string" "= \\(foo\\.string_access\\) 0x0"
-gdb_test "print arr_ptr" "= \\(access foo\\.little_array\\) 0x\[0-9a-zA-Z\]+"
+ gdb_test "print arr_ptr" "= \\(access foo\\.little_array\\) 0x\[0-9a-zA-Z\]+"
-gdb_test "print arr_ptr(2)" "= 22"
+ gdb_test "print arr_ptr(2)" "= 22"
-gdb_test "print arr_ptr(3..4)" "= \\(3 => 23, 24\\)"
+ gdb_test "print arr_ptr(3..4)" "= \\(3 => 23, 24\\)"
-gdb_test "ptype string_access" "= access array \\(<>\\) of character"
+ gdb_test "ptype string_access" "= access array \\(<>\\) of character"
-gdb_test "print pa_ptr.all" \
- " = \\(10, 20, 30, 40, 50, 60, 62, 63, -23, 42\\)"
+ gdb_test "print pa_ptr.all" \
+ " = \\(10, 20, 30, 40, 50, 60, 62, 63, -23, 42\\)"
-gdb_test "print pa_ptr(3)" " = 30"
+ gdb_test "print pa_ptr(3)" " = 30"
-gdb_test "print pa_ptr.all(3)" " = 30"
+ gdb_test "print pa_ptr.all(3)" " = 30"
+}
standard_ada_testfile foo_ra24_010
-if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug}] != ""} {
- return -1
-}
+foreach_with_prefix scenario {all minimal} {
+ set flags [list debug additional_flags=-fgnat-encodings=$scenario]
+
+ if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} {
+ return -1
+ }
-clean_restart ${testfile}
+ clean_restart ${testfile}
-set bp_location [gdb_get_line_number "STOP" ${testdir}/foo_ra24_010.adb]
-runto "foo_ra24_010.adb:$bp_location"
+ set bp_location [gdb_get_line_number "STOP" ${testdir}/foo_ra24_010.adb]
+ runto "foo_ra24_010.adb:$bp_location"
-gdb_test "print good" \
- "= \\(false <repeats 196 times>\\)" \
+ gdb_test "print good" \
+ "= \\(false <repeats 196 times>\\)" \
-gdb_test "print bad" \
- "= \\(false <repeats 196 times>\\)" \
+ gdb_test "print bad" \
+ "= \\(false <repeats 196 times>\\)"
+}
"The current source language is \"c\"." \
"show language when set to 'c'"
- # With -fgnat-encodings=minimal, this works properly in C as well.
- if {$scenario == "minimal"} {
- set expected "\"test\""
- } else {
- set expected "{P_ARRAY = $hex, P_BOUNDS = $hex}"
- }
gdb_test "bt" \
- "#1 $hex in pck\\.call_me \\(s=$expected\\).*" \
+ "#1 $hex in pck\\.call_me \\(s={P_ARRAY = $hex, P_BOUNDS = $hex}\\).*" \
"backtrace with language forced to 'c'"
gdb_test_no_output "set language auto" \
standard_ada_testfile bar
-if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } {
- return -1
-}
-
load_lib mi-support.exp
set MIFLAGS "-i=mi"
-mi_clean_restart $binfile
+foreach_with_prefix scenario {all minimal} {
+ set flags [list debug additional_flags=-fgnat-encodings=$scenario]
-if {[mi_runto_main] < 0} {
- fail "cannot run to main, testcase aborted"
- return 0
-}
+ if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} {
+ return -1
+ }
-set bp_location [gdb_get_line_number "STOP" ${testdir}/bar.adb]
-mi_continue_to_line \
- "bar.adb:$bp_location" \
- "stop at start of main Ada procedure"
+ mi_clean_restart $binfile
-mi_gdb_test "-var-create var1 * Aos" \
- "\\^done,name=\"var1\",numchild=\"2\",.*" \
- "Create var1 varobj"
+ if {[mi_runto_main] < 0} {
+ fail "cannot run to main, testcase aborted"
+ return 0
+ }
-mi_gdb_test "-var-list-children 1 var1" \
- "\\^done,numchild=\"2\",children=\\\[child={name=\"var1.1\",exp=\"1\",numchild=\"1\",value=\"$hex\",type=\"bar.string_access\",thread-id=\"$decimal\"},child={name=\"var1.2\",exp=\"2\",numchild=\"1\",value=\"$hex\",type=\"bar.string_access\",thread-id=\"$decimal\"}\\\],has_more=\"0\"" \
- "list var1's children"
+ set bp_location [gdb_get_line_number "STOP" ${testdir}/bar.adb]
+ mi_continue_to_line \
+ "bar.adb:$bp_location" \
+ "stop at start of main Ada procedure"
-mi_gdb_test "-var-evaluate-expression var1" \
- "\\^done,value=\"\\\[2\\\]\"" \
- "Print var1"
+ mi_gdb_test "-var-create var1 * Aos" \
+ "\\^done,name=\"var1\",numchild=\"2\",.*" \
+ "Create var1 varobj"
-mi_gdb_test "-var-evaluate-expression var1.1" \
- "\\^done,value=\"$hex\"" \
- "Print var1 first child"
+ mi_gdb_test "-var-list-children 1 var1" \
+ "\\^done,numchild=\"2\",children=\\\[child={name=\"var1.1\",exp=\"1\",numchild=\"1\",value=\"$hex\",type=\"bar.string_access\",thread-id=\"$decimal\"},child={name=\"var1.2\",exp=\"2\",numchild=\"1\",value=\"$hex\",type=\"bar.string_access\",thread-id=\"$decimal\"}\\\],has_more=\"0\"" \
+ "list var1's children"
-mi_gdb_test "-var-evaluate-expression var1.2" \
- "\\^done,value=\"$hex\"" \
- "Print var1 second child"
+ mi_gdb_test "-var-evaluate-expression var1" \
+ "\\^done,value=\"\\\[2\\\]\"" \
+ "Print var1"
+
+ mi_gdb_test "-var-evaluate-expression var1.1" \
+ "\\^done,value=\"$hex\"" \
+ "Print var1 first child"
+
+ mi_gdb_test "-var-evaluate-expression var1.2" \
+ "\\^done,value=\"$hex\"" \
+ "Print var1 second child"
+}
standard_ada_testfile foo
-if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } {
- return -1
-}
+foreach_with_prefix scenario {all minimal} {
+ set flags [list debug additional_flags=-fgnat-encodings=$scenario]
+
+ if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} {
+ return -1
+ }
-clean_restart ${testfile}
+ clean_restart ${testfile}
-set bp_location [gdb_get_line_number "START" ${testdir}/foo.adb]
-if ![runto "foo.adb:$bp_location" ] then {
- perror "Couldn't run ${testfile}"
- return
-}
+ set bp_location [gdb_get_line_number "START" ${testdir}/foo.adb]
+ if ![runto "foo.adb:$bp_location" ] then {
+ perror "Couldn't run ${testfile}"
+ return
+ }
-gdb_test "print xp" \
- "= \\(y => \\(-1, -2, -3, -4, -5, -6, -7, -8, -9, -10\\)\\)"
+ # GNAT >= 11.0 has the needed fix here.
+ if {$scenario == "minimal" && ![test_compiler_info {gcc-1[1-9]-*}]} {
+ setup_kfail "minimal encodings" *-*-*
+ }
+ gdb_test "print xp" \
+ "= \\(y => \\(-1, -2, -3, -4, -5, -6, -7, -8, -9, -10\\)\\)"
+}
standard_ada_testfile foo_o224_021
-if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug optimize=-O2}] != ""} {
- return -1
-}
+foreach_with_prefix scenario {all minimal} {
+ set flags [list debug \
+ optimize=-O2 \
+ additional_flags=-fgnat-encodings=$scenario]
+
+ if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} {
+ return -1
+ }
-clean_restart ${testfile}
+ clean_restart ${testfile}
-gdb_test "break foo_o224_021.child1.child2" \
- "Breakpoint \[0-9\]+ at.*: file .*foo_o224_021.adb, line \[0-9\]+."
+ gdb_test "break foo_o224_021.child1.child2" \
+ "Breakpoint \[0-9\]+ at.*: file .*foo_o224_021.adb, line \[0-9\]+."
-gdb_run_cmd
-gdb_test "" \
- "Breakpoint $decimal, foo_o224_021\\.child1\\.child2 \\(s=\\.\\.\\.\\).*"
+ gdb_run_cmd
+ gdb_test "" \
+ "Breakpoint $decimal, foo_o224_021\\.child1\\.child2 \\(s=\\.\\.\\.\\).*"
-set opt_addr_in "($hex in)?"
-gdb_test "bt" \
- [multi_line "#0 +$opt_addr_in +foo_o224_021\\.child1\\.child2 \\(s=\\.\\.\\.\\).*" \
- "#1 +$opt_addr_in +foo_o224_021\\.child1 \\(\\).*" \
- "#2 +$opt_addr_in +foo_o224_021 \\(\\).*" ]
+ set opt_addr_in "($hex in)?"
+ gdb_test "bt" \
+ [multi_line "#0 +$opt_addr_in +foo_o224_021\\.child1\\.child2 \\(s=\\.\\.\\.\\).*" \
+ "#1 +$opt_addr_in +foo_o224_021\\.child1 \\(\\).*" \
+ "#2 +$opt_addr_in +foo_o224_021 \\(\\).*" ]
+}
standard_ada_testfile pa
-if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug}] != ""} {
- return -1
-}
+foreach_with_prefix scenario {all minimal} {
+ set flags [list debug additional_flags=-fgnat-encodings=$scenario]
-clean_restart ${testfile}
+ if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} {
+ return -1
+ }
-set bp_location [gdb_get_line_number "STOP" ${testdir}/pa.adb]
-runto "pa.adb:$bp_location"
+ clean_restart ${testfile}
-gdb_test "print var" \
- "= \\(4 => true, false, true, false, true\\)"
+ set bp_location [gdb_get_line_number "STOP" ${testdir}/pa.adb]
+ runto "pa.adb:$bp_location"
-# Try printing the value and the type definition of a reference
-# to variable "Var".
+ gdb_test "print var" \
+ "= \\(4 => true, false, true, false, true\\)"
-gdb_test "ptype &var" \
- "type = access array \\(4 \\.\\. 8\\) of boolean <packed: 1-bit elements>"
+ # Try printing the value and the type definition of a reference
+ # to variable "Var".
-gdb_test "print &var" \
- "= \\(access pa.packed_array\\) 0x.*"
+ gdb_test "ptype &var" \
+ "type = access array \\(4 \\.\\. 8\\) of boolean <packed: 1-bit elements>"
-# Print the value of U_Var, an unconstrainted packed array.
+ gdb_test "print &var" \
+ "= \\(access pa.packed_array\\) 0x.*"
-set test "print u_var"
-gdb_test_multiple "$test" "$test" {
- -re "= \\(true, false, false, true, true, false\\)\[\r\n\]+$gdb_prompt $" {
- pass $test
- }
- -re "= \\(warning: unable to get bounds of array.*\\)\[\r\n\]+$gdb_prompt $" {
- # The compiler forgot to emit the packed array's ___XA type,
- # preventing us from determining the what the array bounds
- # are. Observed with (FSF GNU Ada 4.5.3 20110124).
- xfail $test
+ # Print the value of U_Var, an unconstrainted packed array.
+
+ set test "print u_var"
+ gdb_test_multiple "$test" "$test" {
+ -re "= \\(true, false, false, true, true, false\\)\[\r\n\]+$gdb_prompt $" {
+ pass $test
+ }
+ -re "= \\(warning: unable to get bounds of array.*\\)\[\r\n\]+$gdb_prompt $" {
+ # The compiler forgot to emit the packed array's ___XA type,
+ # preventing us from determining the what the array bounds
+ # are. Observed with (FSF GNU Ada 4.5.3 20110124).
+ xfail $test
+ }
}
}
-
standard_ada_testfile foo
-if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug}] != ""} {
- return -1
-}
+foreach_with_prefix scenario {all minimal} {
+ set flags [list debug additional_flags=-fgnat-encodings=$scenario]
+
+ if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} {
+ return -1
+ }
-clean_restart ${testfile}
+ clean_restart ${testfile}
-set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb]
-runto "foo.adb:$bp_location"
+ set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb]
+ runto "foo.adb:$bp_location"
-gdb_test "print A2" \
- "= (<ref>\\s*)?\\(false, false\\)" \
- "print var"
+ # GNAT >= 11.0 has the needed fix here.
+ if {$scenario == "minimal" && ![test_compiler_info {gcc-1[1-9]-*}]} {
+ setup_kfail "minimal encodings" *-*-*
+ }
+ gdb_test "print A2" \
+ "= (<ref>\\s*)?\\(false, false\\)" \
+ "print var"
+}
standard_ada_testfile foo
-if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } {
- return -1
-}
+foreach_with_prefix scenario {all minimal} {
+ set flags [list debug additional_flags=-fgnat-encodings=$scenario]
+
+ if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} {
+ return -1
+ }
-clean_restart ${testfile}
+ clean_restart ${testfile}
-set bp_location [gdb_get_line_number "STOP1" ${testdir}/foo.adb]
-runto "foo.adb:$bp_location"
+ set bp_location [gdb_get_line_number "STOP1" ${testdir}/foo.adb]
+ runto "foo.adb:$bp_location"
-# Print My_Object and My_Object.Ptr when Ptr is null...
+ # Print My_Object and My_Object.Ptr when Ptr is null...
-gdb_test "print my_object" \
- "= \\(n => 3, ptr => 0x0, data => \\(3, 5, 8\\)\\)" \
- "print My_Object with null Ptr"
+ gdb_test "print my_object" \
+ "= \\(n => 3, ptr => 0x0, data => \\(3, 5, 8\\)\\)" \
+ "print My_Object with null Ptr"
-gdb_test "print my_object.ptr" \
- "= \\(foo.table_access\\) 0x0" \
- "print My_Object.Ptr when null"
+ gdb_test "print my_object.ptr" \
+ "= \\(foo.table_access\\) 0x0" \
+ "print My_Object.Ptr when null"
-# Same for My_P_Object...
+ # Same for My_P_Object...
-gdb_test "print my_p_object" \
- "= \\(n => 3, ptr => 0x0, data => \\(3, 5, 8\\)\\)" \
- "print My_P_Object with null Ptr"
+ gdb_test "print my_p_object" \
+ "= \\(n => 3, ptr => 0x0, data => \\(3, 5, 8\\)\\)" \
+ "print My_P_Object with null Ptr"
-gdb_test "print my_p_object.ptr" \
- "\\(foo.p_table_access\\) 0x0" \
- "print My_P_Object.Ptr when null"
+ gdb_test "print my_p_object.ptr" \
+ "\\(foo.p_table_access\\) 0x0" \
+ "print My_P_Object.Ptr when null"
-# Continue until the Ptr component of both objects get allocated.
+ # Continue until the Ptr component of both objects get allocated.
-set bp_location [gdb_get_line_number "STOP2" ${testdir}/foo.adb]
+ set bp_location [gdb_get_line_number "STOP2" ${testdir}/foo.adb]
-gdb_breakpoint "foo.adb:$bp_location"
+ gdb_breakpoint "foo.adb:$bp_location"
-gdb_test "continue" \
- "Breakpoint $decimal, foo \\(\\) at .*foo.adb:$decimal.*" \
- "continue to STOP2"
+ gdb_test "continue" \
+ "Breakpoint $decimal, foo \\(\\) at .*foo.adb:$decimal.*" \
+ "continue to STOP2"
-# Inspect My_Object again...
+ # Inspect My_Object again...
-gdb_test "print my_object" \
- "= \\(n => 3, ptr => $hex, data => \\(3, 5, 8\\)\\)" \
- "print my_object after setting Ptr"
+ gdb_test "print my_object" \
+ "= \\(n => 3, ptr => $hex, data => \\(3, 5, 8\\)\\)" \
+ "print my_object after setting Ptr"
-gdb_test "print my_object.ptr" \
- "\\(foo.table_access\\) $hex" \
- "print my_object.ptr when no longer null"
+ gdb_test "print my_object.ptr" \
+ "\\(foo.table_access\\) $hex" \
+ "print my_object.ptr when no longer null"
-gdb_test "print my_object.ptr.all" \
- "= \\(13, 21, 34\\)"
+ gdb_test "print my_object.ptr.all" \
+ "= \\(13, 21, 34\\)"
-# Same with My_P_Object...
+ # Same with My_P_Object...
-gdb_test "print my_p_object" \
- "= \\(n => 3, ptr => $hex, data => \\(3, 5, 8\\)\\)" \
- "print my_p_object after setting Ptr"
+ gdb_test "print my_p_object" \
+ "= \\(n => 3, ptr => $hex, data => \\(3, 5, 8\\)\\)" \
+ "print my_p_object after setting Ptr"
-gdb_test "print my_p_object.ptr" \
- "= \\(foo.p_table_access\\) $hex" \
- "print My_P_Object.Ptr when no longer null"
+ gdb_test "print my_p_object.ptr" \
+ "= \\(foo.p_table_access\\) $hex" \
+ "print My_P_Object.Ptr when no longer null"
-gdb_test "print my_p_object.ptr.all" \
- "\\(13, 21, 34\\)"
+ gdb_test "print my_p_object.ptr.all" \
+ "\\(13, 21, 34\\)"
+}
standard_ada_testfile foo
-if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } {
- return -1
-}
+foreach_with_prefix scenario {all minimal} {
+ set flags [list debug additional_flags=-fgnat-encodings=$scenario]
-clean_restart ${testfile}
+ if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} {
+ return -1
+ }
-set bp_location [gdb_get_line_number "START" ${testdir}/foo.adb]
-runto "foo.adb:$bp_location"
+ clean_restart ${testfile}
-set test "print my_buffer"
-gdb_test_multiple "$test" $test {
- -re "= \\(size => 8, buffer => \\(1, 2, 3, 4, 5, 6, 7, 0\\), length => 8\\)\[\r\n\]+$gdb_prompt $" {
- pass $test
- }
- -re "= \\(size => 8, length => 8, buffer => \\(1, 2, 3, 4, 5, 6, 7, 0\\)\\)\[\r\n\]+$gdb_prompt $" {
- pass $test
+ set bp_location [gdb_get_line_number "START" ${testdir}/foo.adb]
+ runto "foo.adb:$bp_location"
+
+ set test "print my_buffer"
+ gdb_test_multiple "$test" $test {
+ -re "= \\(size => 8, buffer => \\(1, 2, 3, 4, 5, 6, 7, 0\\), length => 8\\)\[\r\n\]+$gdb_prompt $" {
+ pass $test
+ }
+ -re "= \\(size => 8, length => 8, buffer => \\(1, 2, 3, 4, 5, 6, 7, 0\\)\\)\[\r\n\]+$gdb_prompt $" {
+ pass $test
+ }
+ -re " = \\(size => 8, length => 8, buffer => warning: could not find bounds information on packed array.*$gdb_prompt $" {
+ # GNAT >= 11.0 has the needed fix here.
+ if {$scenario == "minimal" && ![test_compiler_info {gcc-1[1-9]-*}]} {
+ setup_kfail "minimal encodings" *-*-*
+ }
+ fail $test
+ }
}
-}
-gdb_test "print my_buffer'Address" \
- "= \\(system\\.address\\) $hex" \
- "print address"
+ gdb_test "print my_buffer'Address" \
+ "= \\(system\\.address\\) $hex" \
+ "print address"
-set test "print {foo.octal_buffer}($)"
-gdb_test_multiple "$test" $test {
- -re "= \\(size => 8, buffer => \\(1, 2, 3, 4, 5, 6, 7, 0\\), length => 8\\)\[\r\n\]+$gdb_prompt $" {
- pass $test
- }
- -re "= \\(size => 8, length => 8, buffer => \\(1, 2, 3, 4, 5, 6, 7, 0\\)\\)\[\r\n\]+$gdb_prompt $" {
- pass $test
+ set test "print {foo.octal_buffer}($)"
+ gdb_test_multiple "$test" $test {
+ -re "= \\(size => 8, buffer => \\(1, 2, 3, 4, 5, 6, 7, 0\\), length => 8\\)\[\r\n\]+$gdb_prompt $" {
+ pass $test
+ }
+ -re "= \\(size => 8, length => 8, buffer => \\(1, 2, 3, 4, 5, 6, 7, 0\\)\\)\[\r\n\]+$gdb_prompt $" {
+ pass $test
+ }
+ -re " = \\(size => 8, length => 8, buffer => warning: could not find bounds information on packed array.*$gdb_prompt $" {
+ # GNAT >= 11.0 has the needed fix here.
+ if {$scenario == "minimal" && ![test_compiler_info {gcc-1[1-9]-*}]} {
+ setup_kfail "minimal encodings" *-*-*
+ }
+ fail $test
+ }
}
}
projects / binutils-gdb.git / commitdiff