From patchwork Mon Sep 10 15:42:03 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Joel Brobecker X-Patchwork-Id: 29288 Received: (qmail 85239 invoked by alias); 10 Sep 2018 15:42:18 -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 85035 invoked by uid 89); 10 Sep 2018 15:42:16 -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.2 spammy=aborted 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; Mon, 10 Sep 2018 15:42:13 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 77BA71161AE; Mon, 10 Sep 2018 11:42:12 -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 URh3IgXSqYda; Mon, 10 Sep 2018 11:42:12 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [IPv6:2620:20:4000:0:46a8:42ff:fe0e:e294]) by rock.gnat.com (Postfix) with ESMTP id 6712D1161AB; Mon, 10 Sep 2018 11:42:12 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4233) id 6657D55F; Mon, 10 Sep 2018 11:42:12 -0400 (EDT) From: Joel Brobecker To: gdb-patches@sourceware.org Cc: Xavier Roirand Subject: [PATCH 1/6] (Ada) Fix -var-list-children MI command for union type Date: Mon, 10 Sep 2018 11:42:03 -0400 Message-Id: <1536594128-6487-2-git-send-email-brobecker@adacore.com> In-Reply-To: <1536594128-6487-1-git-send-email-brobecker@adacore.com> References: <1536594128-6487-1-git-send-email-brobecker@adacore.com> From: Xavier Roirand Using this Ada code: type Union_Type (A : Boolean := False) is record case A is when True => B : Integer; when False => C : Float; end case; end record; pragma Unchecked_Union (Union_Type); Ut : Union_Type := (A => True, B => 3); In GDB/MI mode, once creating a varobj from variable "Ut" as follow: (gdb) -var-create var1 * ut ^done,name="var1",numchild="2",value="{...}",type="foo.union_type",thread-id="1",has_more="0" Printing the list of its children displays: (gdb) -var-list-children 1 var1 ^error,msg="Duplicate variable object name" Whereas it should be (gdb) -var-list-children 1 var1 ^done,numchild="2",children=[child={name="var1.b",exp="b",numchild="0",value="3",type="integer",thread-id="1"},child={name="var1.c",exp="c",numchild="0",value="4.20389539e-45",type="float",thread-id="1"}],has_more="0" The problem occurs because ada_varobj_describe_struct_child wasn't handling unions. This patch fixes this. gdb/ChangeLog: * ada-varobj.c (ada_varobj_describe_struct_child) (ada_varobj_describe_child): Handle union case like struct one. testsuite/ChangeLog * gdb.ada/mi_var_union.exp: New testcase. * gdb.ada/mi_var_union/bar.adb: New file. * gdb.ada/mi_var_union/pck.adb: New file. * gdb.ada/mi_var_union/pck.asd: New file. Tested on x86_64-linux. --- gdb/ChangeLog | 5 +++ gdb/ada-varobj.c | 6 ++-- gdb/testsuite/ChangeLog | 7 ++++ gdb/testsuite/gdb.ada/mi_var_union.exp | 54 ++++++++++++++++++++++++++++++ gdb/testsuite/gdb.ada/mi_var_union/bar.adb | 29 ++++++++++++++++ gdb/testsuite/gdb.ada/mi_var_union/pck.adb | 21 ++++++++++++ gdb/testsuite/gdb.ada/mi_var_union/pck.ads | 19 +++++++++++ 7 files changed, 139 insertions(+), 2 deletions(-) create mode 100644 gdb/testsuite/gdb.ada/mi_var_union.exp create mode 100644 gdb/testsuite/gdb.ada/mi_var_union/bar.adb create mode 100644 gdb/testsuite/gdb.ada/mi_var_union/pck.adb create mode 100644 gdb/testsuite/gdb.ada/mi_var_union/pck.ads diff --git a/gdb/ChangeLog b/gdb/ChangeLog index 7adb11f..ca678dd 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,8 @@ +2018-09-10 Xavier Roirand + + * ada-varobj.c (ada_varobj_describe_struct_child) + (ada_varobj_describe_child): Handle union case like struct one. + 2018-09-10 Tom Tromey PR python/18380: diff --git a/gdb/ada-varobj.c b/gdb/ada-varobj.c index 6dafe47..5baefd9 100644 --- a/gdb/ada-varobj.c +++ b/gdb/ada-varobj.c @@ -419,7 +419,8 @@ ada_varobj_describe_struct_child (struct value *parent_value, int fieldno; int childno = 0; - gdb_assert (TYPE_CODE (parent_type) == TYPE_CODE_STRUCT); + gdb_assert (TYPE_CODE (parent_type) == TYPE_CODE_STRUCT + || TYPE_CODE (parent_type) == TYPE_CODE_UNION); for (fieldno = 0; fieldno < TYPE_NFIELDS (parent_type); fieldno++) { @@ -699,7 +700,8 @@ ada_varobj_describe_child (struct value *parent_value, return; } - if (TYPE_CODE (parent_type) == TYPE_CODE_STRUCT) + if (TYPE_CODE (parent_type) == TYPE_CODE_STRUCT + || TYPE_CODE (parent_type) == TYPE_CODE_UNION) { ada_varobj_describe_struct_child (parent_value, parent_type, parent_name, parent_path_expr, diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog index a360c22..3911b8c 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2018-09-10 Xavier Roirand + + * gdb.ada/mi_var_union.exp: New testcase. + * gdb.ada/mi_var_union/bar.adb: New file. + * gdb.ada/mi_var_union/pck.adb: New file. + * gdb.ada/mi_var_union/pck.asd: New file. + 2018-09-08 Tom Tromey * gdb.python/py-prettyprint.exp: Use with_test_prefix. diff --git a/gdb/testsuite/gdb.ada/mi_var_union.exp b/gdb/testsuite/gdb.ada/mi_var_union.exp new file mode 100644 index 0000000..26a7ed0 --- /dev/null +++ b/gdb/testsuite/gdb.ada/mi_var_union.exp @@ -0,0 +1,54 @@ +# Copyright 2018 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 bar + +if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } { + return -1 +} + +load_lib mi-support.exp +set MIFLAGS "-i=mi" + +gdb_exit +if [mi_gdb_start] { + continue +} + +set float "\\-?((\[0-9\]+(\\.\[0-9\]+)?(e\[-+\]\[0-9\]+)?)|(nan\\($hex\\)))" + +mi_delete_breakpoints +mi_gdb_reinitialize_dir $srcdir/$subdir +mi_gdb_load ${binfile} + +if ![mi_run_to_main] then { + fail "Cannot run to main, testcase aborted" + return 0 +} + +set bp_location [gdb_get_line_number "STOP" ${testdir}/bar.adb] +mi_continue_to_line \ + "bar.adb:$bp_location" \ + "stop at start of main Ada procedure" + +mi_gdb_test "-var-create var1 * Ut" \ + "\\^done,name=\"var1\",numchild=\"2\",.*" \ + "Create var1 varobj" + +mi_gdb_test "-var-list-children 1 var1" \ + "\\^done,numchild=\"2\",children=\\\[child={name=\"var1.b\",exp=\"b\",numchild=\"0\",value=\"3\",type=\"integer\",thread-id=\"$decimal\"},child={name=\"var1.c\",exp=\"c\",numchild=\"0\",value=\"$float\",type=\"float\",thread-id=\"$decimal\"}\\\],has_more=\"0\"" \ + "list var1's children" diff --git a/gdb/testsuite/gdb.ada/mi_var_union/bar.adb b/gdb/testsuite/gdb.ada/mi_var_union/bar.adb new file mode 100644 index 0000000..9563f34 --- /dev/null +++ b/gdb/testsuite/gdb.ada/mi_var_union/bar.adb @@ -0,0 +1,29 @@ +-- Copyright 2018 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 Bar is + type Union_Type (A : Boolean := False) is record + case A is + when True => B : Integer; + when False => C : Float; + end case; + end record; + pragma Unchecked_Union (Union_Type); + Ut : Union_Type := (A => True, B => 3); +begin + Do_Nothing (Ut'Address); -- STOP +end Bar; diff --git a/gdb/testsuite/gdb.ada/mi_var_union/pck.adb b/gdb/testsuite/gdb.ada/mi_var_union/pck.adb new file mode 100644 index 0000000..dcfb306 --- /dev/null +++ b/gdb/testsuite/gdb.ada/mi_var_union/pck.adb @@ -0,0 +1,21 @@ +-- Copyright 2018 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/mi_var_union/pck.ads b/gdb/testsuite/gdb.ada/mi_var_union/pck.ads new file mode 100644 index 0000000..33e369e --- /dev/null +++ b/gdb/testsuite/gdb.ada/mi_var_union/pck.ads @@ -0,0 +1,19 @@ +-- Copyright 2018 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;