From patchwork Wed Mar 13 21:41:57 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tom Tromey X-Patchwork-Id: 31847 Received: (qmail 123018 invoked by alias); 13 Mar 2019 21:42:02 -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 123010 invoked by uid 89); 13 Mar 2019 21:42:02 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.9 required=5.0 tests=BAYES_00, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, KAM_SHORT, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.1 spammy=UD:G, Joel, Ada, HIGH 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 ESMTP; Wed, 13 Mar 2019 21:42:00 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 1CEED56140; Wed, 13 Mar 2019 17:41:59 -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 70Ln0B7MJpJM; Wed, 13 Mar 2019 17:41:59 -0400 (EDT) Received: from murgatroyd.Home (174-29-37-56.hlrn.qwest.net [174.29.37.56]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by rock.gnat.com (Postfix) with ESMTPSA id C46165613E; Wed, 13 Mar 2019 17:41:58 -0400 (EDT) From: Tom Tromey To: gdb-patches@sourceware.org Cc: Tom Tromey Subject: [PATCH] Fix Ada "ptype" bug with array types Date: Wed, 13 Mar 2019 15:41:57 -0600 Message-Id: <20190313214157.24522-1-tromey@adacore.com> MIME-Version: 1.0 Using ptype on an array type in Ada can sometimes show an incorrect high bound. This happens because ada_evaluate_subexp will create an array with an incorrect upper bound in the EVAL_AVOID_SIDE_EFFECTS case. This patch fixes the problem by arranging to always create such an array with valid bounds. Tested on x86-64 Fedora 29. gdb/ChangeLog 2019-03-13 Tom Tromey * ada-lang.c (empty_array): Add "high" parameter. (ada_evaluate_subexp): Update. gdb/testsuite/ChangeLog 2019-03-13 Joel Brobecker Tom Tromey * gdb.ada/ptype_array/pck.adb: New file. * gdb.ada/ptype_array/pck.ads: New file. * gdb.ada/ptype_array/foo.adb: New file. * gdb.ada/ptype_array.exp: New file. --- gdb/ChangeLog | 5 ++++ gdb/ada-lang.c | 17 +++++++----- gdb/testsuite/ChangeLog | 8 ++++++ gdb/testsuite/gdb.ada/ptype_array.exp | 34 +++++++++++++++++++++++ gdb/testsuite/gdb.ada/ptype_array/foo.adb | 21 ++++++++++++++ gdb/testsuite/gdb.ada/ptype_array/pck.adb | 23 +++++++++++++++ gdb/testsuite/gdb.ada/ptype_array/pck.ads | 30 ++++++++++++++++++++ 7 files changed, 131 insertions(+), 7 deletions(-) create mode 100644 gdb/testsuite/gdb.ada/ptype_array.exp create mode 100644 gdb/testsuite/gdb.ada/ptype_array/foo.adb create mode 100644 gdb/testsuite/gdb.ada/ptype_array/pck.adb create mode 100644 gdb/testsuite/gdb.ada/ptype_array/pck.ads diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c index a6fadc846e3..7153436e738 100644 --- a/gdb/ada-lang.c +++ b/gdb/ada-lang.c @@ -3173,16 +3173,18 @@ ada_array_length (struct value *arr, int n) return high - low + 1; } -/* An empty array whose type is that of ARR_TYPE (an array type), - with bounds LOW to LOW-1. */ +/* An array whose type is that of ARR_TYPE (an array type), with + bounds LOW to HIGH, but whose contents are unimportant. If HIGH is + less than LOW, then LOW-1 is used. */ static struct value * -empty_array (struct type *arr_type, int low) +empty_array (struct type *arr_type, int low, int high) { struct type *arr_type0 = ada_check_typedef (arr_type); struct type *index_type = create_static_range_type - (NULL, TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (arr_type0)), low, low - 1); + (NULL, TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (arr_type0)), low, + high < low ? low - 1 : high); struct type *elt_type = ada_array_element_type (arr_type0, 1); return allocate_value (create_array_type (NULL, elt_type, index_type)); @@ -11033,7 +11035,8 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp, if (noside == EVAL_AVOID_SIDE_EFFECTS && ada_is_array_descriptor_type (ada_check_typedef (value_type (array)))) - return empty_array (ada_type_of_array (array, 0), low_bound); + return empty_array (ada_type_of_array (array, 0), low_bound, + high_bound); array = ada_coerce_to_simple_array_ptr (array); @@ -11057,7 +11060,7 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp, struct type *type0 = ada_check_typedef (value_type (array)); if (high_bound < low_bound || noside == EVAL_AVOID_SIDE_EFFECTS) - return empty_array (TYPE_TARGET_TYPE (type0), low_bound); + return empty_array (TYPE_TARGET_TYPE (type0), low_bound, high_bound); else { struct type *arr_type0 = @@ -11071,7 +11074,7 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp, else if (noside == EVAL_AVOID_SIDE_EFFECTS) return array; else if (high_bound < low_bound) - return empty_array (value_type (array), low_bound); + return empty_array (value_type (array), low_bound, high_bound); else return ada_value_slice (array, longest_to_int (low_bound), longest_to_int (high_bound)); diff --git a/gdb/testsuite/gdb.ada/ptype_array.exp b/gdb/testsuite/gdb.ada/ptype_array.exp new file mode 100644 index 00000000000..ec75d14d003 --- /dev/null +++ b/gdb/testsuite/gdb.ada/ptype_array.exp @@ -0,0 +1,34 @@ +# Copyright 2019 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 additional_flags=-gnat05 ]] != "" } { + return -1 +} + +clean_restart ${testfile} + +runto_main + +gdb_test "ptype pck.W.G(1,5).m(2 .. 5)" \ + "type = array \\(2 \\.\\. 5\\) of character" \ + "ptype 2..5" + +gdb_test "ptype pck.W.G(1,5).m(3 .. 5)" \ + "type = array \\(3 \\.\\. 5\\) of character" \ + "ptype 3..5" diff --git a/gdb/testsuite/gdb.ada/ptype_array/foo.adb b/gdb/testsuite/gdb.ada/ptype_array/foo.adb new file mode 100644 index 00000000000..c1688cbdc70 --- /dev/null +++ b/gdb/testsuite/gdb.ada/ptype_array/foo.adb @@ -0,0 +1,21 @@ +-- Copyright 2019 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; + +procedure Foo is +begin + Pck.Do_Nothing (Pck.W.G'Address); +end Foo; diff --git a/gdb/testsuite/gdb.ada/ptype_array/pck.adb b/gdb/testsuite/gdb.ada/ptype_array/pck.adb new file mode 100644 index 00000000000..5a2019a9774 --- /dev/null +++ b/gdb/testsuite/gdb.ada/ptype_array/pck.adb @@ -0,0 +1,23 @@ +-- Copyright 2019 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/ptype_array/pck.ads b/gdb/testsuite/gdb.ada/ptype_array/pck.ads new file mode 100644 index 00000000000..7b81930141a --- /dev/null +++ b/gdb/testsuite/gdb.ada/ptype_array/pck.ads @@ -0,0 +1,30 @@ +-- Copyright 2019 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 + package W is + type P is record + M : String (2 .. 5); + end record; + + type R is array (1 .. 10, 1 .. 20) of P; + + G : R; + end W; + + procedure Do_Nothing (A : System.Address); +end Pck;