diff options
author | Xavier Roirand <roirand@adacore.com> | 2018-09-10 10:30:50 -0500 |
---|---|---|
committer | Joel Brobecker <brobecker@adacore.com> | 2018-09-10 11:30:50 -0400 |
commit | 2963898f38dab323a9e381d7c41a26b9c3498882 (patch) | |
tree | f2a7149b0fcf4ddb831705fe31e3f206dc002e57 | |
parent | 849cba3b83f8b808521ef5b1aaa8fb33c04bd9fa (diff) | |
download | gdb-2963898f38dab323a9e381d7c41a26b9c3498882.zip gdb-2963898f38dab323a9e381d7c41a26b9c3498882.tar.gz gdb-2963898f38dab323a9e381d7c41a26b9c3498882.tar.bz2 |
(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.
-rw-r--r-- | gdb/ChangeLog | 5 | ||||
-rw-r--r-- | gdb/ada-varobj.c | 6 | ||||
-rw-r--r-- | gdb/testsuite/ChangeLog | 7 | ||||
-rw-r--r-- | gdb/testsuite/gdb.ada/mi_var_union.exp | 54 | ||||
-rw-r--r-- | gdb/testsuite/gdb.ada/mi_var_union/bar.adb | 29 | ||||
-rw-r--r-- | gdb/testsuite/gdb.ada/mi_var_union/pck.adb | 21 | ||||
-rw-r--r-- | gdb/testsuite/gdb.ada/mi_var_union/pck.ads | 19 |
7 files changed, 139 insertions, 2 deletions
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 <roirand@adacore.com> + + * ada-varobj.c (ada_varobj_describe_struct_child) + (ada_varobj_describe_child): Handle union case like struct one. + 2018-09-10 Tom Tromey <tom@tromey.com> 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 <roirand@adacore.com> + + * 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 <tom@tromey.com> * 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 <http://www.gnu.org/licenses/>. + +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 <http://www.gnu.org/licenses/>. + +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 <http://www.gnu.org/licenses/>. + +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 <http://www.gnu.org/licenses/>. + +with System; +package Pck is + procedure Do_Nothing (A : System.Address); +end Pck; |