From 2963898f38dab323a9e381d7c41a26b9c3498882 Mon Sep 17 00:00:00 2001 From: Xavier Roirand Date: Mon, 10 Sep 2018 10:30:50 -0500 Subject: [PATCH] (Ada) Fix -var-list-children MI command for union type 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 7adb11f4f0a..ca678dd1d97 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 6dafe472c74..5baefd997b3 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 a360c225ef8..3911b8cd242 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 00000000000..26a7ed0dd46 --- /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 00000000000..9563f348c59 --- /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 00000000000..dcfb3068d3b --- /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 00000000000..33e369ef860 --- /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; -- 2.30.2