From patchwork Fri Nov 14 16:44:12 2014 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Joel Brobecker X-Patchwork-Id: 3738 Received: (qmail 4371 invoked by alias); 14 Nov 2014 16:44:28 -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 4267 invoked by uid 89); 14 Nov 2014 16:44:27 -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; Fri, 14 Nov 2014 16:44:24 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id BF1581168A0 for ; Fri, 14 Nov 2014 11:44:22 -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 HT315JOflgtc for ; Fri, 14 Nov 2014 11:44:22 -0500 (EST) Received: from joel.gnat.com (localhost.localdomain [127.0.0.1]) by rock.gnat.com (Postfix) with ESMTP id 3EFB4116869 for ; Fri, 14 Nov 2014 11:44:22 -0500 (EST) Received: by joel.gnat.com (Postfix, from userid 1000) id A220C40F79; Fri, 14 Nov 2014 20:44:20 +0400 (RET) From: Joel Brobecker To: gdb-patches@sourceware.org Subject: [commit/Ada] Ignore __XA types when redundant. Date: Fri, 14 Nov 2014 20:44:12 +0400 Message-Id: <1415983452-26484-1-git-send-email-brobecker@adacore.com> Hello, Consider the following code which declares a variable A2 which is an array of arrays of integers. type Array2_First is array (24 .. 26) of Integer; type Array2_Second is array (1 .. 2) of Array2_First; A1 : Array1_Second := ((10, 11, 12), (13, 14, 15)); Trying to print the type of that variable currently yields: (gdb) ptype A2 type = array (1 .. 2, 24 .. 26) of integer This is not correct, as this is the description of a two-dimension array, which is different from an array of arrays. The expected output is: (gdb) ptype a2 type = array (1 .. 2) of foo_n926_029.array2_first GDB's struct type currently handles multi-dimension arrays the same way arrays of arrays, where each dimension is stored as a sub-array. The ada-valprint module considers that consecutive array layers are in fact multi-dimension arrays. For array of arrays, a typedef layer is introduced between the two arrays, creating a break between each array type. In our situation, A2 is a described as a typedef of an array type... .uleb128 0x8 # (DIE (0x125) DW_TAG_variable) .ascii "a2\0" # DW_AT_name .long 0xfc # DW_AT_type .uleb128 0x4 # (DIE (0xfc) DW_TAG_typedef) .long .LASF5 # DW_AT_name: "foo__array2_second" .long 0x107 # DW_AT_type .uleb128 0x5 # (DIE (0x107) DW_TAG_array_type) .long .LASF5 # DW_AT_name: "foo__array2_second" .long 0xb4 # DW_AT_type .uleb128 0x6 # (DIE (0x114) DW_TAG_subrange_type) .long 0x11b # DW_AT_type .byte 0x2 # DW_AT_upper_bound .byte 0 # end of children of DIE 0x107 ... whose element type is, as expected, a typedef to the sub-array type: .uleb128 0x4 # (DIE (0xb4) DW_TAG_typedef) .long .LASF4 # DW_AT_name: "foo__array2_first" .long 0xbf # DW_AT_type .uleb128 0x9 # (DIE (0xbf) DW_TAG_array_type) .long .LASF4 # DW_AT_name: "foo__array2_first" .long 0xd8 # DW_AT_GNAT_descriptive_type .long 0x1c5 # DW_AT_type .uleb128 0xa # (DIE (0xd0) DW_TAG_subrange_type) .long 0xf0 # DW_AT_type .byte 0x18 # DW_AT_lower_bound .byte 0x1a # DW_AT_upper_bound .byte 0 # end of children of DIE 0xbf The reason why things fails is that, during expression evaluation, GDB tries to "fix" A1's type. Because the sub-array has a parallel (descriptive) type (DIE 0xd8), GDB thinks that our array's index type must be dynamic and therefore needs to be fixed. This in turn causes the sub-array to be "fixed", which itself results in the typedef layer to be stripped. However, looking closer at the parallel type, we see... .uleb128 0xb # (DIE (0xd8) DW_TAG_structure_type) .long .LASF8 # DW_AT_name: "foo__array2_first___XA" [...] .uleb128 0xc # (DIE (0xe4) DW_TAG_member) .long .LASF10 # DW_AT_name: "foo__Tarray2_firstD1___XDLU_24__26" ... that all it tells us is that the array bounds are 24 and 26, which is already correctly provided by the array's DW_TAG_subrange_type bounds, meaning that this parallel type is just redundant. Parallel types in general are slowly being removed in favor of standard DWARF constructs. But in the meantime, this patch kills two birds with one stone: 1. It recognizes this situation where the XA type is useless, and saves an unnecessary range-type fixing; 2. It fixes the issue at hand because ignoring the XA type results in no type fixing being required, which allows the typedef layer to be preserved. gdb/ChangeLog: * ada-lang.c (ada_is_redundant_range_encoding): New function. (ada_is_redundant_index_type_desc): New function. (to_fixed_array_type): Ignore parallel XA type if redundant. gdb/testsuite/ChangeLog: * gdb.ada/arr_arr: New testcase. Tested on x86_64-linux. I will push the patch sometime next week... Thanks, diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c index 5b5c22f..b576839 100644 --- a/gdb/ada-lang.c +++ b/gdb/ada-lang.c @@ -8309,6 +8309,68 @@ to_fixed_variant_branch_type (struct type *var_type0, const gdb_byte *valaddr, return TYPE_FIELD_TYPE (var_type, which); } +/* Assuming RANGE_TYPE is a TYPE_CODE_RANGE, return nonzero if + ENCODING_TYPE, a type following the GNAT conventions for discrete + type encodings, only carries redundant information. */ + +static int +ada_is_redundant_range_encoding (struct type *range_type, + struct type *encoding_type) +{ + struct type *fixed_range_type; + char *bounds_str; + int n; + LONGEST lo, hi; + + gdb_assert (TYPE_CODE (range_type) == TYPE_CODE_RANGE); + + if (is_dynamic_type (range_type)) + return 0; + + if (TYPE_NAME (encoding_type) == NULL) + return 0; + + bounds_str = strstr (TYPE_NAME (encoding_type), "___XDLU_"); + if (bounds_str == NULL) + return 0; + + n = 8; /* Skip "___XDLU_". */ + if (!ada_scan_number (bounds_str, n, &lo, &n)) + return 0; + if (TYPE_LOW_BOUND (range_type) != lo) + return 0; + + n += 2; /* Skip the "__" separator between the two bounds. */ + if (!ada_scan_number (bounds_str, n, &hi, &n)) + return 0; + if (TYPE_HIGH_BOUND (range_type) != hi) + return 0; + + return 1; +} + +/* Given the array type ARRAY_TYPE, return nonzero if DESC_TYPE, + a type following the GNAT encoding for describing array type + indices, only carries redundant information. */ + +static int +ada_is_redundant_index_type_desc (struct type *array_type, + struct type *desc_type) +{ + struct type *this_layer = check_typedef (array_type); + int i; + + for (i = 0; i < TYPE_NFIELDS (desc_type); i++) + { + if (!ada_is_redundant_range_encoding (TYPE_INDEX_TYPE (this_layer), + TYPE_FIELD_TYPE (desc_type, i))) + return 0; + this_layer = check_typedef (TYPE_TARGET_TYPE (this_layer)); + } + + return 1; +} + /* Assuming that TYPE0 is an array type describing the type of a value at ADDR, and that DVAL describes a record containing any discriminants used in TYPE0, returns a type for the value that @@ -8335,6 +8397,17 @@ to_fixed_array_type (struct type *type0, struct value *dval, index_type_desc = ada_find_parallel_type (type0, "___XA"); ada_fixup_array_indexes_type (index_type_desc); + if (index_type_desc != NULL + && ada_is_redundant_index_type_desc (type0, index_type_desc)) + { + /* Ignore this ___XA parallel type, as it does not bring any + useful information. This allows us to avoid creating fixed + versions of the array's index types, which would be identical + to the original ones. This, in turn, can also help avoid + the creation of fixed versions of the array itself. */ + index_type_desc = NULL; + } + if (index_type_desc == NULL) { struct type *elt_type0 = ada_check_typedef (TYPE_TARGET_TYPE (type0)); diff --git a/gdb/testsuite/gdb.ada/arr_arr.exp b/gdb/testsuite/gdb.ada/arr_arr.exp new file mode 100644 index 0000000..2be18e0 --- /dev/null +++ b/gdb/testsuite/gdb.ada/arr_arr.exp @@ -0,0 +1,33 @@ +# Copyright 2014 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 + +if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } { + return -1 +} + +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 +} + +gdb_test "ptype a2" \ + " = array \\(1 \\.\\. 2\\) of foo.array2_first" diff --git a/gdb/testsuite/gdb.ada/arr_arr/foo.adb b/gdb/testsuite/gdb.ada/arr_arr/foo.adb new file mode 100644 index 0000000..b4af104 --- /dev/null +++ b/gdb/testsuite/gdb.ada/arr_arr/foo.adb @@ -0,0 +1,25 @@ +-- Copyright 2014 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; +with Pck; use Pck; + +procedure Foo is + type Array2_First is array (24 .. 26) of Integer; + type Array2_Second is array (1 .. 2) of Array2_First; + A2 : Array2_Second := ((10, 11, 12), (13, 14, 15)); +begin + Do_Nothing (A2'Address); -- START +end Foo; diff --git a/gdb/testsuite/gdb.ada/arr_arr/pck.adb b/gdb/testsuite/gdb.ada/arr_arr/pck.adb new file mode 100644 index 0000000..2b31332 --- /dev/null +++ b/gdb/testsuite/gdb.ada/arr_arr/pck.adb @@ -0,0 +1,21 @@ +-- Copyright 2014 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 + procedure Do_Nothing (A : System.Address) is + begin + null; + end Do_Nothing; +end Pck; diff --git a/gdb/testsuite/gdb.ada/arr_arr/pck.ads b/gdb/testsuite/gdb.ada/arr_arr/pck.ads new file mode 100644 index 0000000..100d7d5 --- /dev/null +++ b/gdb/testsuite/gdb.ada/arr_arr/pck.ads @@ -0,0 +1,19 @@ +-- Copyright 2014 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 + procedure Do_Nothing (A : System.Address); +end Pck;