From patchwork Thu Jan 15 09:59:56 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Joel Brobecker X-Patchwork-Id: 4698 Received: (qmail 24338 invoked by alias); 15 Jan 2015 10:00:20 -0000 Mailing-List: contact gdb-patches-help@sourceware.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Subscribe: List-Archive: List-Post: List-Help: , Sender: gdb-patches-owner@sourceware.org Delivered-To: mailing list gdb-patches@sourceware.org Received: (qmail 24136 invoked by uid 89); 15 Jan 2015 10:00:18 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-1.7 required=5.0 tests=AWL, BAYES_00, SPF_PASS, T_RP_MATCHES_RCVD autolearn=ham version=3.3.2 X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-SHA encrypted) ESMTPS; Thu, 15 Jan 2015 10:00:09 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 9286A1163F2 for ; Thu, 15 Jan 2015 05:00:07 -0500 (EST) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id EkYZoWf6bDFF for ; Thu, 15 Jan 2015 05:00:07 -0500 (EST) Received: from joel.gnat.com (localhost.localdomain [127.0.0.1]) by rock.gnat.com (Postfix) with ESMTP id 51E261162C1 for ; Thu, 15 Jan 2015 05:00:05 -0500 (EST) Received: by joel.gnat.com (Postfix, from userid 1000) id AD9C548E8B; Thu, 15 Jan 2015 14:00:02 +0400 (RET) From: Joel Brobecker To: gdb-patches@sourceware.org Subject: [PATCH 3/3] gdb/DWARF: Support for arrays whose bound is a discriminant. Date: Thu, 15 Jan 2015 13:59:56 +0400 Message-Id: <1421315996-22616-4-git-send-email-brobecker@adacore.com> In-Reply-To: <1421315996-22616-1-git-send-email-brobecker@adacore.com> References: <1421315996-22616-1-git-send-email-brobecker@adacore.com> Consider the following declarations: type Array_Type is array (Integer range <>) of Integer; type Record_Type (N : Integer) is record A : Array_Type (1 .. N); end record; R : Record_Type := Get (10); It defines what Ada programers call a "discriminated record", where "N" is a component of that record called a "discriminant", and where "A" is a component defined as an array type whose upper bound is equal to the value of the discriminant. So far, we rely on a number of fairly complex GNAT-specific encodings to handle this situation. This patch is to enhance GDB to be able to print this record in the case where the compiler has been modified to replace those encodings by pure DWARF constructs. In particular, the debugging information generated for the record above looks like the following. "R" is a record.. .uleb128 0x10 # (DIE (0x13e) DW_TAG_structure_type) .long .LASF17 # DW_AT_name: "foo__record_type" ... whose is is of course dynamic (not our concern here)... .uleb128 0xd # DW_AT_byte_size .byte 0x97 # DW_OP_push_object_address .byte 0x94 # DW_OP_deref_size .byte 0x4 .byte 0x99 # DW_OP_call4 .long 0x19b .byte 0x23 # DW_OP_plus_uconst .uleb128 0x7 .byte 0x9 # DW_OP_const1s .byte 0xfc .byte 0x1a # DW_OP_and .byte 0x1 # DW_AT_decl_file (foo.adb) .byte 0x6 # DW_AT_decl_line ... and then has 2 members, fist "n" (our discriminant); .uleb128 0x11 # (DIE (0x153) DW_TAG_member) .ascii "n\0" # DW_AT_name .byte 0x1 # DW_AT_decl_file (foo.adb) .byte 0x6 # DW_AT_decl_line .long 0x194 # DW_AT_type .byte 0 # DW_AT_data_member_location ... and "A"... .uleb128 0x11 # (DIE (0x181) DW_TAG_member) .ascii "a\0" # DW_AT_name .long 0x15d # DW_AT_type .byte 0x4 # DW_AT_data_member_location ... which is an array ... .uleb128 0x12 # (DIE (0x15d) DW_TAG_array_type) .long .LASF18 # DW_AT_name: "foo__record_type__T4b" .long 0x194 # DW_AT_type ... whose lower bound is implicitly 1, and the upper bound a reference to DIE 0x153 = "N": .uleb128 0x13 # (DIE (0x16a) DW_TAG_subrange_type) .long 0x174 # DW_AT_type .long 0x153 # DW_AT_upper_bound This patch enhanced GDB to understand references to other DIEs where the DIE's address is at an offset of its enclosing type. The difficulty was that the address used to resolve the array's type (R's address + 4 bytes) is different from the address used as the base to compute N's address (an offset to R's address). We're solving this issue by using a stack of addresses rather than a single address when trying to resolve a type. Each address in the stack corresponds to each containing level. For instance, if resolving the field of a struct, the stack should contain the address of the field at the top, and then the address of the struct. That way, if the field makes a reference to an object of the struct, we can retrieve the address of that struct, and properly resolve the dynamic property references that struct. gdb/ChangeLog: * gdbtypes.h (struct dynamic_prop): New PROP_ADDR_OFFSET enum kind. * gdbtypes.c (resolve_dynamic_type_internal): Replace "addr" parameter by "addr_stack" parameter. (resolve_dynamic_range): Replace "addr" parameter by "stack_addr" parameter. Update function documentation. Update code accordingly. (resolve_dynamic_array, resolve_dynamic_union) (resolve_dynamic_struct, resolve_dynamic_type_internal): Likewise. (resolve_dynamic_type): Update code, following the changes made to resolve_dynamic_type_internal's interface. * dwarf2loc.h (struct property_addr_info): New. (dwarf2_evaluate_property): Replace "address" parameter by "addr_stack" parameter. Adjust function documentation. (struct dwarf2_offset_baton): New. (struct dwarf2_property_baton): Update documentation of field "referenced_type" to be more general. New field "offset_info" in union data field. * dwarf2loc.c (dwarf2_evaluate_property): Replace "address" parameter by "addr_stack" parameter. Adjust code accordingly. Add support for PROP_ADDR_OFFSET properties. * dwarf2read.c (attr_to_dynamic_prop): Add support for DW_AT_data_member_location attributes as well. Use case statements instead of if/else condition. gdb/testsuite/ChangeLog: * gdb.ada/disc_arr_bound: New testcase. Tested on x86_64-linux, no regression. Comments? diff --git a/gdb/dwarf2loc.c b/gdb/dwarf2loc.c index bdb2160..fae67ee 100644 --- a/gdb/dwarf2loc.c +++ b/gdb/dwarf2loc.c @@ -2461,7 +2461,8 @@ dwarf2_locexpr_baton_eval (const struct dwarf2_locexpr_baton *dlbaton, int dwarf2_evaluate_property (const struct dynamic_prop *prop, - CORE_ADDR address, CORE_ADDR *value) + struct property_addr_info *addr_stack, + CORE_ADDR *value) { if (prop == NULL) return 0; @@ -2472,7 +2473,8 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop, { const struct dwarf2_property_baton *baton = prop->data.baton; - if (dwarf2_locexpr_baton_eval (&baton->locexpr, address, value)) + if (dwarf2_locexpr_baton_eval (&baton->locexpr, addr_stack->addr, + value)) { if (baton->referenced_type) { @@ -2511,6 +2513,23 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop, case PROP_CONST: *value = prop->data.const_val; return 1; + + case PROP_ADDR_OFFSET: + { + struct dwarf2_property_baton *baton = prop->data.baton; + struct property_addr_info *pinfo; + struct value *val; + + for (pinfo = addr_stack; pinfo != NULL; pinfo = pinfo->next) + if (pinfo->type == baton->referenced_type) + break; + if (pinfo == NULL) + error ("cannot find reference address for offset property"); + val = value_at (baton->offset_info.type, + pinfo->addr + baton->offset_info.offset); + *value = value_as_address (val); + return 1; + } } return 0; diff --git a/gdb/dwarf2loc.h b/gdb/dwarf2loc.h index a369361..0932456 100644 --- a/gdb/dwarf2loc.h +++ b/gdb/dwarf2loc.h @@ -102,13 +102,30 @@ struct value *dwarf2_evaluate_loc_desc (struct type *type, size_t size, struct dwarf2_per_cu_data *per_cu); -/* Converts a dynamic property into a static one. ADDRESS is the address - of the object currently being evaluated and might be nedded. +/* A chain of addresses that might be needed to resolve a dynamic + property. */ + +struct property_addr_info +{ + /* The type of the object whose dynamic properties, if any, are + being resolved. */ + struct type *type; + + /* The address of that object. */ + CORE_ADDR addr; + + /* If not NULL, a pointer to the info for the object containing + the object described by this node. */ + struct property_addr_info *next; +}; + +/* Converts a dynamic property into a static one. ADDR_STACK is the stack + of addresses that might be needed to evaluate the property. Returns 1 if PROP could be converted and the static value is passed back into VALUE, otherwise returns 0. */ int dwarf2_evaluate_property (const struct dynamic_prop *prop, - CORE_ADDR address, + struct property_addr_info *addr_stack, CORE_ADDR *value); /* A helper for the compiler interface that compiles a single dynamic @@ -177,6 +194,23 @@ struct dwarf2_loclist_baton unsigned char from_dwo; }; +/* The baton used when a dynamic property is an offset to a parent + type. This can be used, for instance, then the bound of an array + inside a record is determined by the value of another field inside + that record. */ + +struct dwarf2_offset_baton +{ + /* The offset from the parent type where the value of the property + is stored. In the example provided above, this would be the offset + of the field being used as the array bound. */ + LONGEST offset; + + /* The type of the object whose property is dynamic. In the example + provided above, this would the the array's index type. */ + struct type *type; +}; + /* A dynamic property is either expressed as a single location expression or a location list. If the property is an indirection, pointing to another die, keep track of the targeted type in REFERENCED_TYPE. */ @@ -184,7 +218,7 @@ struct dwarf2_loclist_baton struct dwarf2_property_baton { /* If the property is an indirection, we need to evaluate the location - LOCEXPR or LOCLIST in the context of the type REFERENCED_TYPE. + in the context of the type REFERENCED_TYPE. If NULL, the location is the actual value of the property. */ struct type *referenced_type; union @@ -194,6 +228,9 @@ struct dwarf2_property_baton /* Location list to be evaluated in the context of REFERENCED_TYPE. */ struct dwarf2_loclist_baton loclist; + + /* The location is an offset to REFERENCED_TYPE. */ + struct dwarf2_offset_baton offset_info; }; }; diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c index 96b2537..48c8527 100644 --- a/gdb/dwarf2read.c +++ b/gdb/dwarf2read.c @@ -14614,33 +14614,58 @@ attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die, target_die = follow_die_ref (die, attr, &target_cu); target_attr = dwarf2_attr (target_die, DW_AT_location, target_cu); if (target_attr == NULL) + target_attr = dwarf2_attr (target_die, DW_AT_data_member_location, + target_cu); + if (target_attr == NULL) return 0; - if (attr_form_is_section_offset (target_attr)) - { - baton = obstack_alloc (obstack, sizeof (*baton)); - baton->referenced_type = die_type (target_die, target_cu); - fill_in_loclist_baton (cu, &baton->loclist, target_attr); - prop->data.baton = baton; - prop->kind = PROP_LOCLIST; - gdb_assert (prop->data.baton != NULL); - } - else if (attr_form_is_block (target_attr)) - { - baton = obstack_alloc (obstack, sizeof (*baton)); - baton->referenced_type = die_type (target_die, target_cu); - baton->locexpr.per_cu = cu->per_cu; - baton->locexpr.size = DW_BLOCK (target_attr)->size; - baton->locexpr.data = DW_BLOCK (target_attr)->data; - prop->data.baton = baton; - prop->kind = PROP_LOCEXPR; - gdb_assert (prop->data.baton != NULL); - } - else + switch (target_attr->name) { - dwarf2_invalid_attrib_class_complaint ("DW_AT_location", - "dynamic property"); - return 0; + case DW_AT_location: + if (attr_form_is_section_offset (target_attr)) + { + baton = obstack_alloc (obstack, sizeof (*baton)); + baton->referenced_type = die_type (target_die, target_cu); + fill_in_loclist_baton (cu, &baton->loclist, target_attr); + prop->data.baton = baton; + prop->kind = PROP_LOCLIST; + gdb_assert (prop->data.baton != NULL); + } + else if (attr_form_is_block (target_attr)) + { + baton = obstack_alloc (obstack, sizeof (*baton)); + baton->referenced_type = die_type (target_die, target_cu); + baton->locexpr.per_cu = cu->per_cu; + baton->locexpr.size = DW_BLOCK (target_attr)->size; + baton->locexpr.data = DW_BLOCK (target_attr)->data; + prop->data.baton = baton; + prop->kind = PROP_LOCEXPR; + gdb_assert (prop->data.baton != NULL); + } + else + { + dwarf2_invalid_attrib_class_complaint ("DW_AT_location", + "dynamic property"); + return 0; + } + break; + case DW_AT_data_member_location: + { + LONGEST offset; + + if (!handle_data_member_location (target_die, target_cu, + &offset)) + return 0; + + baton = obstack_alloc (obstack, sizeof (*baton)); + baton->referenced_type = get_die_type (target_die->parent, + target_cu); + baton->offset_info.offset = offset; + baton->offset_info.type = die_type (target_die, target_cu); + prop->data.baton = baton; + prop->kind = PROP_ADDR_OFFSET; + break; + } } } else if (attr_form_is_constant (attr)) diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c index 22b6ce4..e6e402e 100644 --- a/gdb/gdbtypes.c +++ b/gdb/gdbtypes.c @@ -1695,15 +1695,16 @@ is_dynamic_type (struct type *type) return is_dynamic_type_internal (type, 1); } -static struct type *resolve_dynamic_type_internal (struct type *type, - CORE_ADDR addr, - int top_level); +static struct type *resolve_dynamic_type_internal + (struct type *type, struct property_addr_info *addr_stack, int top_level); -/* Given a dynamic range type (dyn_range_type) and address, - return a static version of that type. */ +/* Given a dynamic range type (dyn_range_type) and a stack of + struct property_addr_info elements, return a static version + of that type. */ static struct type * -resolve_dynamic_range (struct type *dyn_range_type, CORE_ADDR addr) +resolve_dynamic_range (struct type *dyn_range_type, + struct property_addr_info *addr_stack) { CORE_ADDR value; struct type *static_range_type, *static_target_type; @@ -1714,7 +1715,7 @@ resolve_dynamic_range (struct type *dyn_range_type, CORE_ADDR addr) gdb_assert (TYPE_CODE (dyn_range_type) == TYPE_CODE_RANGE); prop = &TYPE_RANGE_DATA (dyn_range_type)->low; - if (dwarf2_evaluate_property (prop, addr, &value)) + if (dwarf2_evaluate_property (prop, addr_stack, &value)) { low_bound.kind = PROP_CONST; low_bound.data.const_val = value; @@ -1726,7 +1727,7 @@ resolve_dynamic_range (struct type *dyn_range_type, CORE_ADDR addr) } prop = &TYPE_RANGE_DATA (dyn_range_type)->high; - if (dwarf2_evaluate_property (prop, addr, &value)) + if (dwarf2_evaluate_property (prop, addr_stack, &value)) { high_bound.kind = PROP_CONST; high_bound.data.const_val = value; @@ -1743,7 +1744,7 @@ resolve_dynamic_range (struct type *dyn_range_type, CORE_ADDR addr) static_target_type = resolve_dynamic_type_internal (TYPE_TARGET_TYPE (dyn_range_type), - addr, 0); + addr_stack, 0); static_range_type = create_range_type (copy_type (dyn_range_type), static_target_type, &low_bound, &high_bound); @@ -1752,11 +1753,12 @@ resolve_dynamic_range (struct type *dyn_range_type, CORE_ADDR addr) } /* Resolves dynamic bound values of an array type TYPE to static ones. - ADDRESS might be needed to resolve the subrange bounds, it is the location - of the associated array. */ + ADDR_STACK is a stack of struct property_addr_info to be used + if needed during the dynamic resolution. */ static struct type * -resolve_dynamic_array (struct type *type, CORE_ADDR addr) +resolve_dynamic_array (struct type *type, + struct property_addr_info *addr_stack) { CORE_ADDR value; struct type *elt_type; @@ -1767,12 +1769,12 @@ resolve_dynamic_array (struct type *type, CORE_ADDR addr) elt_type = type; range_type = check_typedef (TYPE_INDEX_TYPE (elt_type)); - range_type = resolve_dynamic_range (range_type, addr); + range_type = resolve_dynamic_range (range_type, addr_stack); ary_dim = check_typedef (TYPE_TARGET_TYPE (elt_type)); if (ary_dim != NULL && TYPE_CODE (ary_dim) == TYPE_CODE_ARRAY) - elt_type = resolve_dynamic_array (TYPE_TARGET_TYPE (type), addr); + elt_type = resolve_dynamic_array (TYPE_TARGET_TYPE (type), addr_stack); else elt_type = TYPE_TARGET_TYPE (type); @@ -1782,10 +1784,12 @@ resolve_dynamic_array (struct type *type, CORE_ADDR addr) } /* Resolve dynamic bounds of members of the union TYPE to static - bounds. */ + bounds. ADDR_STACK is a stack of struct property_addr_info + to be used if needed during the dynamic resolution. */ static struct type * -resolve_dynamic_union (struct type *type, CORE_ADDR addr) +resolve_dynamic_union (struct type *type, + struct property_addr_info *addr_stack) { struct type *resolved_type; int i; @@ -1808,7 +1812,7 @@ resolve_dynamic_union (struct type *type, CORE_ADDR addr) continue; t = resolve_dynamic_type_internal (TYPE_FIELD_TYPE (resolved_type, i), - addr, 0); + addr_stack, 0); TYPE_FIELD_TYPE (resolved_type, i) = t; if (TYPE_LENGTH (t) > max_len) max_len = TYPE_LENGTH (t); @@ -1819,10 +1823,12 @@ resolve_dynamic_union (struct type *type, CORE_ADDR addr) } /* Resolve dynamic bounds of members of the struct TYPE to static - bounds. */ + bounds. ADDR_STACK is a stack of struct property_addr_info to + be used if needed during the dynamic resolution. */ static struct type * -resolve_dynamic_struct (struct type *type, CORE_ADDR addr) +resolve_dynamic_struct (struct type *type, + struct property_addr_info *addr_stack) { struct type *resolved_type; int i; @@ -1841,14 +1847,11 @@ resolve_dynamic_struct (struct type *type, CORE_ADDR addr) for (i = 0; i < TYPE_NFIELDS (resolved_type); ++i) { unsigned new_bit_length; + struct property_addr_info pinfo; if (field_is_static (&TYPE_FIELD (type, i))) continue; - TYPE_FIELD_TYPE (resolved_type, i) - = resolve_dynamic_type_internal (TYPE_FIELD_TYPE (resolved_type, i), - addr, 0); - /* As we know this field is not a static field, the field's field_loc_kind should be FIELD_LOC_KIND_BITPOS. Verify this is the case, but only trigger a simple error rather @@ -1856,9 +1859,20 @@ resolve_dynamic_struct (struct type *type, CORE_ADDR addr) that verification indicates a bug in our code, the error is not severe enough to suggest to the user he stops his debugging session because of it. */ - if (TYPE_FIELD_LOC_KIND (resolved_type, i) != FIELD_LOC_KIND_BITPOS) + if (TYPE_FIELD_LOC_KIND (type, i) != FIELD_LOC_KIND_BITPOS) error (_("Cannot determine struct field location" " (invalid location kind)")); + + pinfo.type = check_typedef (TYPE_FIELD_TYPE (type, i)); + pinfo.addr = addr_stack->addr; + pinfo.next = addr_stack; + + TYPE_FIELD_TYPE (resolved_type, i) + = resolve_dynamic_type_internal (TYPE_FIELD_TYPE (resolved_type, i), + &pinfo, 0); + gdb_assert (TYPE_FIELD_LOC_KIND (resolved_type, i) + == FIELD_LOC_KIND_BITPOS); + new_bit_length = TYPE_FIELD_BITPOS (resolved_type, i); if (TYPE_FIELD_BITSIZE (resolved_type, i) != 0) new_bit_length += TYPE_FIELD_BITSIZE (resolved_type, i); @@ -1885,7 +1899,8 @@ resolve_dynamic_struct (struct type *type, CORE_ADDR addr) /* Worker for resolved_dynamic_type. */ static struct type * -resolve_dynamic_type_internal (struct type *type, CORE_ADDR addr, +resolve_dynamic_type_internal (struct type *type, + struct property_addr_info *addr_stack, int top_level) { struct type *real_type = check_typedef (type); @@ -1900,7 +1915,7 @@ resolve_dynamic_type_internal (struct type *type, CORE_ADDR addr, { resolved_type = copy_type (type); TYPE_TARGET_TYPE (resolved_type) - = resolve_dynamic_type_internal (TYPE_TARGET_TYPE (type), addr, + = resolve_dynamic_type_internal (TYPE_TARGET_TYPE (type), addr_stack, top_level); } else @@ -1912,36 +1927,40 @@ resolve_dynamic_type_internal (struct type *type, CORE_ADDR addr, { case TYPE_CODE_REF: { - CORE_ADDR target_addr = read_memory_typed_address (addr, type); + struct property_addr_info pinfo; + + pinfo.type = check_typedef (TYPE_TARGET_TYPE (type)); + pinfo.addr = read_memory_typed_address (addr_stack->addr, type); + pinfo.next = addr_stack; resolved_type = copy_type (type); TYPE_TARGET_TYPE (resolved_type) = resolve_dynamic_type_internal (TYPE_TARGET_TYPE (type), - target_addr, top_level); + &pinfo, top_level); break; } case TYPE_CODE_ARRAY: - resolved_type = resolve_dynamic_array (type, addr); + resolved_type = resolve_dynamic_array (type, addr_stack); break; case TYPE_CODE_RANGE: - resolved_type = resolve_dynamic_range (type, addr); + resolved_type = resolve_dynamic_range (type, addr_stack); break; case TYPE_CODE_UNION: - resolved_type = resolve_dynamic_union (type, addr); + resolved_type = resolve_dynamic_union (type, addr_stack); break; case TYPE_CODE_STRUCT: - resolved_type = resolve_dynamic_struct (type, addr); + resolved_type = resolve_dynamic_struct (type, addr_stack); break; } } /* Resolve data_location attribute. */ prop = TYPE_DATA_LOCATION (resolved_type); - if (dwarf2_evaluate_property (prop, addr, &value)) + if (dwarf2_evaluate_property (prop, addr_stack, &value)) { TYPE_DATA_LOCATION_ADDR (resolved_type) = value; TYPE_DATA_LOCATION_KIND (resolved_type) = PROP_CONST; @@ -1957,7 +1976,9 @@ resolve_dynamic_type_internal (struct type *type, CORE_ADDR addr, struct type * resolve_dynamic_type (struct type *type, CORE_ADDR addr) { - return resolve_dynamic_type_internal (type, addr, 1); + struct property_addr_info pinfo = {check_typedef (type), addr, NULL}; + + return resolve_dynamic_type_internal (type, &pinfo, 1); } /* Find the real type of TYPE. This function returns the real type, diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h index 7c06a4f..a8139ce 100644 --- a/gdb/gdbtypes.h +++ b/gdb/gdbtypes.h @@ -405,6 +405,7 @@ struct dynamic_prop { PROP_UNDEFINED, /* Not defined. */ PROP_CONST, /* Constant. */ + PROP_ADDR_OFFSET, /* Address offset. */ PROP_LOCEXPR, /* Location expression. */ PROP_LOCLIST /* Location list. */ } kind; diff --git a/gdb/testsuite/gdb.ada/disc_arr_bound.exp b/gdb/testsuite/gdb.ada/disc_arr_bound.exp new file mode 100644 index 0000000..10f1afa --- /dev/null +++ b/gdb/testsuite/gdb.ada/disc_arr_bound.exp @@ -0,0 +1,36 @@ +# Copyright 2015 Free Software Foundation, Inc. +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +load_lib "ada.exp" + +standard_ada_testfile foo_n612_026 + +if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } { + return -1 +} + +clean_restart ${testfile} + +set bp_location [gdb_get_line_number "STOP" ${testdir}/foo_n612_026.adb] +if ![runto "foo_n612_026.adb:$bp_location" ] then { + perror "Couldn't run ${testfile}" + return +} + +gdb_test "print r" \ + " = \\(n => 10, a => \\(10, 20, 30, 40, 50, 60, 70, 80, 90, 100\\)\\)" + +gdb_test "print r.a" \ + " = \\(10, 20, 30, 40, 50, 60, 70, 80, 90, 100\\)" diff --git a/gdb/testsuite/gdb.ada/disc_arr_bound/foo_n612_026.adb b/gdb/testsuite/gdb.ada/disc_arr_bound/foo_n612_026.adb new file mode 100644 index 0000000..d4bbf33 --- /dev/null +++ b/gdb/testsuite/gdb.ada/disc_arr_bound/foo_n612_026.adb @@ -0,0 +1,22 @@ +-- Copyright 2015 Free Software Foundation, Inc. +-- +-- This program is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 3 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . + +with Pck; use Pck; + +procedure Foo_N612_026 is + R : Record_Type := Get (10); +begin + Do_Nothing (R'Address); -- STOP +end Foo_N612_026; diff --git a/gdb/testsuite/gdb.ada/disc_arr_bound/pck.adb b/gdb/testsuite/gdb.ada/disc_arr_bound/pck.adb new file mode 100644 index 0000000..a755520 --- /dev/null +++ b/gdb/testsuite/gdb.ada/disc_arr_bound/pck.adb @@ -0,0 +1,32 @@ +-- Copyright 2015 Free Software Foundation, Inc. +-- +-- This program is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 3 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . + +package body Pck is + + function Get (N : Integer) return Record_Type is + Result : Record_Type (N); + begin + for I in 1 .. N loop + Result.A (I) := 10 * I; + end loop; + return Result; + end Get; + + procedure Do_Nothing (A : System.Address) is + begin + null; + end Do_Nothing; + +end Pck; diff --git a/gdb/testsuite/gdb.ada/disc_arr_bound/pck.ads b/gdb/testsuite/gdb.ada/disc_arr_bound/pck.ads new file mode 100644 index 0000000..08c858f --- /dev/null +++ b/gdb/testsuite/gdb.ada/disc_arr_bound/pck.ads @@ -0,0 +1,29 @@ +-- Copyright 2015 Free Software Foundation, Inc. +-- +-- This program is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 3 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . + +with System; + +package Pck is + + type Array_Type is array (Integer range <>) of Integer; + type Record_Type (N : Integer) is record + A : Array_Type (1 .. N); + end record; + + function Get (N : Integer) return Record_Type; + + procedure Do_Nothing (A : System.Address); + +end Pck;