From patchwork Wed Sep 2 07:21:13 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Pierre-Marie de Rodat X-Patchwork-Id: 8556 Received: (qmail 62255 invoked by alias); 2 Sep 2015 07:21:23 -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 62242 invoked by uid 89); 2 Sep 2015 07:21:23 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-0.3 required=5.0 tests=AWL, BAYES_05, KAM_LAZY_DOMAIN_SECURITY, RCVD_IN_DNSWL_LOW autolearn=no version=3.3.2 X-HELO: smtp.eu.adacore.com Received: from mel.act-europe.fr (HELO smtp.eu.adacore.com) (194.98.77.210) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-GCM-SHA384 encrypted) ESMTPS; Wed, 02 Sep 2015 07:21:21 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 8A86A28F38F7; Wed, 2 Sep 2015 09:21:18 +0200 (CEST) Received: from smtp.eu.adacore.com ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id KrfL_mJT3Jfa; Wed, 2 Sep 2015 09:21:18 +0200 (CEST) Received: from cacatoes.act-europe.fr (cacatoes.act-europe.fr [10.10.1.112]) (using TLSv1.2 with cipher ECDHE-RSA-AES128-SHA256 (128/128 bits)) (No client certificate requested) by smtp.eu.adacore.com (Postfix) with ESMTPSA id 7920F28F38E9; Wed, 2 Sep 2015 09:21:18 +0200 (CEST) From: Pierre-Marie de Rodat To: gdb-patches@sourceware.org Cc: Pierre-Marie de Rodat Subject: [PATCH] [Ada] Fix handling of array renamings Date: Wed, 2 Sep 2015 09:21:13 +0200 Message-Id: <1441178473-18654-1-git-send-email-derodat@adacore.com> X-IsSubscribed: yes Compilers can materialize renamings of arrays (or of accesses to arrays) in Ada into variables whose types are references to the actual array types. Before this change, trying to use such an array renaming yielded an error in GDB: (gdb) print my_array(1) cannot subscript or call a record (gdb) print my_array_ptr(1) cannot subscript or call something of type `(null)' This behavior comes from bad handling for array renamings, in particular the OP_FUNCALL expression operator handling from ada-lang.c (ada_evaluate_subexp): in one place we turn the reference into a pointer, but the code that follows expect the value to be an array. This patch fixes how we handle references in call/subscript evaluation so that we turn these references into the actual array values instead of pointers to them. gdb/ChangeLog: * ada-lang.c (ada_evaluate_subexp) : When the input value is a reference, actually dereference it in order to get the underlying value. gdb/testsuite/ChangeLog: * gdb.ada/array_ptr_renaming.exp: New testcase. * gdb.ada/array_ptr_renaming/foo.adb: New file. * gdb.ada/array_ptr_renaming/pack.ads: New file. Tested on x86_64-linux, no regression. --- gdb/ada-lang.c | 15 ++++++--- gdb/testsuite/gdb.ada/array_ptr_renaming.exp | 39 +++++++++++++++++++++++ gdb/testsuite/gdb.ada/array_ptr_renaming/foo.adb | 25 +++++++++++++++ gdb/testsuite/gdb.ada/array_ptr_renaming/pack.ads | 25 +++++++++++++++ 4 files changed, 100 insertions(+), 4 deletions(-) create mode 100644 gdb/testsuite/gdb.ada/array_ptr_renaming.exp create mode 100644 gdb/testsuite/gdb.ada/array_ptr_renaming/foo.adb create mode 100644 gdb/testsuite/gdb.ada/array_ptr_renaming/pack.ads diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c index a7809ff..3e45316 100644 --- a/gdb/ada-lang.c +++ b/gdb/ada-lang.c @@ -10629,10 +10629,17 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp, therefore already coerced to a simple array. Nothing further to do. */ ; - else if (TYPE_CODE (value_type (argvec[0])) == TYPE_CODE_REF - || (TYPE_CODE (value_type (argvec[0])) == TYPE_CODE_ARRAY - && VALUE_LVAL (argvec[0]) == lval_memory)) - argvec[0] = value_addr (argvec[0]); + else if (TYPE_CODE (value_type (argvec[0])) == TYPE_CODE_REF) + { + /* Make sure we dereference references so that all the code below + feels like it's really handling the referenced value. Wrapping + types (for alignment) may be there, so make sure we strip them as + well. */ + argvec[0] = ada_to_fixed_value (coerce_ref (argvec[0])); + } + else if (TYPE_CODE (value_type (argvec[0])) == TYPE_CODE_ARRAY + && VALUE_LVAL (argvec[0]) == lval_memory) + argvec[0] = value_addr (argvec[0]); type = ada_check_typedef (value_type (argvec[0])); diff --git a/gdb/testsuite/gdb.ada/array_ptr_renaming.exp b/gdb/testsuite/gdb.ada/array_ptr_renaming.exp new file mode 100644 index 0000000..a33202e --- /dev/null +++ b/gdb/testsuite/gdb.ada/array_ptr_renaming.exp @@ -0,0 +1,39 @@ +# 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 + +if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } { + return -1 +} + +clean_restart ${testfile} + +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" + +# 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/NNNN" *-*-* +gdb_test "print ntp" " = \\(access pack\\.table_type\\) 0x.*" +gdb_test "print ntp.all" " = \\(3 => 30, 40\\)" +gdb_test "print ntp(3)" " = 30" diff --git a/gdb/testsuite/gdb.ada/array_ptr_renaming/foo.adb b/gdb/testsuite/gdb.ada/array_ptr_renaming/foo.adb new file mode 100644 index 0000000..ead98bc --- /dev/null +++ b/gdb/testsuite/gdb.ada/array_ptr_renaming/foo.adb @@ -0,0 +1,25 @@ +-- 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; +with Pack; + +procedure Foo is + NT : Pack.Table_Type renames Pack.Table; + NTP : Pack.Table_Ptr_Type renames Pack.Table_Ptr; +begin + NT := NT; -- BREAK + NTP := NTP; +end Foo; diff --git a/gdb/testsuite/gdb.ada/array_ptr_renaming/pack.ads b/gdb/testsuite/gdb.ada/array_ptr_renaming/pack.ads new file mode 100644 index 0000000..d88d046 --- /dev/null +++ b/gdb/testsuite/gdb.ada/array_ptr_renaming/pack.ads @@ -0,0 +1,25 @@ +-- 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 Pack is + + type Table_Type is + array (Natural range <>) of Integer; + type Table_Ptr_Type is access all Table_Type; + + Table : Table_Type := (1 => 10, 2 => 20); + Table_Ptr : aliased Table_Ptr_Type := new Table_Type'(3 => 30, 4 => 40); + +end Pack;