From patchwork Fri May 15 21:08:16 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Joel Brobecker X-Patchwork-Id: 6755 Received: (qmail 126083 invoked by alias); 15 May 2015 21:08: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 126073 invoked by uid 89); 15 May 2015 21:08:28 -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, 15 May 2015 21:08:21 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 8E91528A3F; Fri, 15 May 2015 17:08:19 -0400 (EDT) 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 uiyiu2sNl31R; Fri, 15 May 2015 17:08:19 -0400 (EDT) Received: from joel.gnat.com (localhost.localdomain [127.0.0.1]) by rock.gnat.com (Postfix) with ESMTP id 580BF28A3E; Fri, 15 May 2015 17:08:19 -0400 (EDT) Received: by joel.gnat.com (Postfix, from userid 1000) id 1AE6640DAA; Fri, 15 May 2015 14:08:23 -0700 (PDT) From: Joel Brobecker To: gdb-patches@sourceware.org Cc: Jerome Guitton Subject: [PATCH] Non bit-packed packed arrays as variable-length fields Date: Fri, 15 May 2015 14:08:16 -0700 Message-Id: <1431724096-25192-1-git-send-email-brobecker@adacore.com> From: Jerome Guitton On behalf of Jerome Guitton: In the case of non bit-packed arrays, GNAT does not generate its traditional XP encoding; it is not needed. However, it still generates the so-called "implementation type" with a P suffix. This implementation type shall be skipped when looking for other descriptive types such as XA encodings for variable-length fields. Note also that there may be an intermediate typedef between the implementation type and its XA description. It shall be skipped as well. gdb/ChangeLog: Jerome Guitton * ada-lang.c (find_parallel_type_by_descriptive_type): Go through typedefs during lookup. (to_fixed_array_type): Add support for non-bit packed arrays as variable-length fields. gdb/testsuite/ChangeLog: * gdb.ada/byte_packed_arr: New testcase. Tested on x86_64-linux, no regression. Pushed to master. Thanks, diff --git a/gdb/ChangeLog b/gdb/ChangeLog index b7694c7..c1dc2d0 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,10 @@ +2015-05-15 Jerome Guitton + + * ada-lang.c (find_parallel_type_by_descriptive_type): + Go through typedefs during lookup. + (to_fixed_array_type): Add support for non-bit packed arrays + as variable-length fields. + 2015-05-15 Pedro Alves Simon Marchi diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c index e3fa363..02d82ef 100644 --- a/gdb/ada-lang.c +++ b/gdb/ada-lang.c @@ -7762,7 +7762,7 @@ ada_type_name (struct type *type) static struct type * find_parallel_type_by_descriptive_type (struct type *type, const char *name) { - struct type *result; + struct type *result, *tmp; if (ada_ignore_descriptive_types_p) return NULL; @@ -7789,9 +7789,21 @@ find_parallel_type_by_descriptive_type (struct type *type, const char *name) /* Otherwise, look at the next item on the list, if any. */ if (HAVE_GNAT_AUX_INFO (result)) - result = TYPE_DESCRIPTIVE_TYPE (result); + tmp = TYPE_DESCRIPTIVE_TYPE (result); else - result = NULL; + tmp = NULL; + + /* If not found either, try after having resolved the typedef. */ + if (tmp != NULL) + result = tmp; + else + { + CHECK_TYPEDEF (result); + if (HAVE_GNAT_AUX_INFO (result)) + result = TYPE_DESCRIPTIVE_TYPE (result); + else + result = NULL; + } } /* If we didn't find a match, see whether this is a packed array. With @@ -8509,6 +8521,7 @@ to_fixed_array_type (struct type *type0, struct value *dval, struct type *index_type_desc; struct type *result; int constrained_packed_array_p; + static const char *xa_suffix = "___XA"; type0 = ada_check_typedef (type0); if (TYPE_FIXED_INSTANCE (type0)) @@ -8518,7 +8531,30 @@ to_fixed_array_type (struct type *type0, struct value *dval, if (constrained_packed_array_p) type0 = decode_constrained_packed_array_type (type0); - index_type_desc = ada_find_parallel_type (type0, "___XA"); + index_type_desc = ada_find_parallel_type (type0, xa_suffix); + + /* As mentioned in exp_dbug.ads, for non bit-packed arrays an + encoding suffixed with 'P' may still be generated. If so, + it should be used to find the XA type. */ + + if (index_type_desc == NULL) + { + const char *typename = ada_type_name (type0); + + if (typename != NULL) + { + const int len = strlen (typename); + char *name = (char *) alloca (len + strlen (xa_suffix)); + + if (typename[len - 1] == 'P') + { + strcpy (name, typename); + strcpy (name + len - 1, xa_suffix); + index_type_desc = ada_find_parallel_type_with_name (type0, name); + } + } + } + ada_fixup_array_indexes_type (index_type_desc); if (index_type_desc != NULL && ada_is_redundant_index_type_desc (type0, index_type_desc)) diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog index cc2c156..74559f4 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,5 +1,9 @@ 2015-05-15 Joel Brobecker + * gdb.ada/byte_packed_arr: New testcase. + +2015-05-15 Joel Brobecker + * gdb.ada/pckd_neg: New testcase. 2015-05-13 Patrick Palka diff --git a/gdb/testsuite/gdb.ada/byte_packed_arr.exp b/gdb/testsuite/gdb.ada/byte_packed_arr.exp new file mode 100644 index 0000000..1a66f59 --- /dev/null +++ b/gdb/testsuite/gdb.ada/byte_packed_arr.exp @@ -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 . + +load_lib "ada.exp" + +if { [skip_ada_tests] } { return -1 } + +standard_ada_testfile reprod_main + +if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug}] != ""} { + return -1 +} + +clean_restart ${testfile} + +set bp_location [gdb_get_line_number "STOP" ${testdir}/reprod.adb] +runto "reprod.adb:$bp_location" + +gdb_test "print broken" \ + " = \\(len => 1, data => \\(\\(i => 1\\)\\)\\)" diff --git a/gdb/testsuite/gdb.ada/byte_packed_arr/array_list_g.ads b/gdb/testsuite/gdb.ada/byte_packed_arr/array_list_g.ads new file mode 100644 index 0000000..288d88f --- /dev/null +++ b/gdb/testsuite/gdb.ada/byte_packed_arr/array_list_g.ads @@ -0,0 +1,27 @@ +-- 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 . + +generic + type Index_Base_T is range <>; + type Component_T is private; +package Array_List_G is + + subtype Length_T is Index_Base_T range 0 .. Index_Base_T'Last; + subtype Index_T is Length_T range 1 .. Length_T'Last; + + type T is array (Index_T range <>) of Component_T; + pragma Pack(T); + +end Array_List_G; diff --git a/gdb/testsuite/gdb.ada/byte_packed_arr/reprod.adb b/gdb/testsuite/gdb.ada/byte_packed_arr/reprod.adb new file mode 100644 index 0000000..6beacab --- /dev/null +++ b/gdb/testsuite/gdb.ada/byte_packed_arr/reprod.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 . + +package body Reprod is + + procedure Do_Nothing (Broken : Obj_T) is + begin + null; -- STOP + end Do_Nothing; +end Reprod; diff --git a/gdb/testsuite/gdb.ada/byte_packed_arr/reprod.ads b/gdb/testsuite/gdb.ada/byte_packed_arr/reprod.ads new file mode 100644 index 0000000..9a2c325 --- /dev/null +++ b/gdb/testsuite/gdb.ada/byte_packed_arr/reprod.ads @@ -0,0 +1,35 @@ +-- 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 Array_List_G; + +package Reprod is + + package Objects is + type T is record + I : Integer; + end record; + package List is new Array_List_G (Index_Base_T => Natural, + Component_T => T); + end Objects; + + type Obj_T (Len : Natural) is record + Data : Objects.List.T (1 .. Len); + end record; + + type T is access Obj_T; + + procedure Do_Nothing (Broken : Obj_T); +end Reprod; diff --git a/gdb/testsuite/gdb.ada/byte_packed_arr/reprod_main.adb b/gdb/testsuite/gdb.ada/byte_packed_arr/reprod_main.adb new file mode 100644 index 0000000..09f804f --- /dev/null +++ b/gdb/testsuite/gdb.ada/byte_packed_arr/reprod_main.adb @@ -0,0 +1,23 @@ +-- 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 Reprod; use Reprod; + +procedure Reprod_Main is + O : Obj_T (Len => 1); +begin + O.Data := (others => (I => 1)); + Do_Nothing (O); +end Reprod_Main;