aboutsummaryrefslogtreecommitdiff
path: root/gdb
diff options
context:
space:
mode:
authorXavier Roirand <roirand@adacore.com>2018-09-10 10:33:32 -0500
committerJoel Brobecker <brobecker@adacore.com>2018-09-10 11:33:32 -0400
commitb9c50e9a9ac48662b2132583c52d46976efb3512 (patch)
tree9e7d7a2e2692a79eeb6278ffe4f21a34f9dc50d1 /gdb
parent736ade86ea3dd3df31120b6c617d64c88bcc86c1 (diff)
downloadgdb-b9c50e9a9ac48662b2132583c52d46976efb3512.zip
gdb-b9c50e9a9ac48662b2132583c52d46976efb3512.tar.gz
gdb-b9c50e9a9ac48662b2132583c52d46976efb3512.tar.bz2
(Ada/MI) Fix -var-evaluate-expression for access to unconstrained arrays
Using this Ada code: type String_Access is access String; type Array_Of_String is array (1 .. 2) of String_Access; Aos : Array_Of_String := (new String'("ab"), new String'("cd")); In GDB/MI mode, create a variable which type is Aos, evaluate it: (gdb) -var-create var1 * Aos ^done,name="var1",numchild="2",value="[2]",type="bar.array_of_string",thread-id="1",has_more="0" Now print it: (gdb) -var-list-children 1 var1 ^done,numchild="2",children=[child={name="var1.1",exp="1",numchild="1",value="[2] \"ab\"", type="bar.string_access",thread-id="1"},child={name="var1.2",exp="2",numchild="1",value="[2] \"cd\"", type="bar.string_access",thread-id="1"}],has_more="0" But printed fields "value" are wrong, since it should be: ^done,numchild="2",children=[child={name="var1.1",exp="1",numchild="1",value="0x634018",type="bar.string_access",thread-id="1"},child={name="var1.2",exp="2",numchild="1",value="0x634038",type="bar.string_access",thread-id="1"}],has_more="0"^M Print each child of var1: (gdb) -var-evaluate-expression var1.1 ^done,value="[2] \"ab\"" (gdb) -var-evaluate-expression var1.2 ^done,value="[2] \"cd\"" Whereas it should be (gdb) -var-evaluate-expression var1.1 ^done,value="0x635018" (gdb) -var-evaluate-expression var1.2 ^done,value="0x635038" This patch fixes this. gdb/ChangeLog: * ada-lang.c (ada_value_subscript): Handle case when parameter is an array of access to unconstrained array. testsuite/ChangeLog * gdb.ada/mi_string_access.exp: New testcase. * gdb.ada/mi_string_access/bar.adb: New file. * gdb.ada/mi_string_access/pck.adb: New file. * gdb.ada/mi_string_access/pck.asd: New file. Tested on x86_64-linux.
Diffstat (limited to 'gdb')
-rw-r--r--gdb/ChangeLog5
-rw-r--r--gdb/ada-lang.c24
-rw-r--r--gdb/testsuite/ChangeLog7
-rw-r--r--gdb/testsuite/gdb.ada/mi_string_access.exp64
-rw-r--r--gdb/testsuite/gdb.ada/mi_string_access/bar.adb24
-rw-r--r--gdb/testsuite/gdb.ada/mi_string_access/pck.adb21
-rw-r--r--gdb/testsuite/gdb.ada/mi_string_access/pck.ads19
7 files changed, 164 insertions, 0 deletions
diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 5401864..40b7978 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,5 +1,10 @@
2018-09-10 Xavier Roirand <roirand@adacore.com>
+ * ada-lang.c (ada_value_subscript): Handle case when parameter is
+ an array of access to unconstrained array.
+
+2018-09-10 Xavier Roirand <roirand@adacore.com>
+
* ada-lang.c (ada_is_access_to_unconstrained_array): New function.
(ada_check_typedef): Use it.
diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index 83421ac..5f39def 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -2861,10 +2861,34 @@ ada_value_subscript (struct value *arr, int arity, struct value **ind)
for (k = 0; k < arity; k += 1)
{
+ struct type *saved_elt_type = TYPE_TARGET_TYPE (elt_type);
+
if (TYPE_CODE (elt_type) != TYPE_CODE_ARRAY)
error (_("too many subscripts (%d expected)"), k);
+
elt = value_subscript (elt, pos_atr (ind[k]));
+
+ if (ada_is_access_to_unconstrained_array (saved_elt_type)
+ && TYPE_CODE (value_type (elt)) != TYPE_CODE_TYPEDEF)
+ {
+ /* The element is a typedef to an unconstrained array,
+ except that the value_subscript call stripped the
+ typedef layer. The typedef layer is GNAT's way to
+ specify that the element is, at the source level, an
+ access to the unconstrained array, rather than the
+ unconstrained array. So, we need to restore that
+ typedef layer, which we can do by forcing the element's
+ type back to its original type. Otherwise, the returned
+ value is going to be printed as the array, rather
+ than as an access. Another symptom of the same issue
+ would be that an expression trying to dereference the
+ element would also be improperly rejected. */
+ deprecated_set_value_type (elt, saved_elt_type);
+ }
+
+ elt_type = ada_check_typedef (value_type (elt));
}
+
return elt;
}
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index 3911b8c..8c47e86 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,5 +1,12 @@
2018-09-10 Xavier Roirand <roirand@adacore.com>
+ * gdb.ada/mi_string_access.exp: New testcase.
+ * gdb.ada/mi_string_access/bar.adb: New file.
+ * gdb.ada/mi_string_access/pck.adb: New file.
+ * gdb.ada/mi_string_access/pck.asd: New file.
+
+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.
diff --git a/gdb/testsuite/gdb.ada/mi_string_access.exp b/gdb/testsuite/gdb.ada/mi_string_access.exp
new file mode 100644
index 0000000..8ecf907
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/mi_string_access.exp
@@ -0,0 +1,64 @@
+# 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
+}
+
+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 * Aos" \
+ "\\^done,name=\"var1\",numchild=\"2\",.*" \
+ "Create var1 varobj"
+
+mi_gdb_test "-var-list-children 1 var1" \
+ "\\^done,numchild=\"2\",children=\\\[child={name=\"var1.1\",exp=\"1\",numchild=\"1\",value=\"$hex\",type=\"bar.string_access\",thread-id=\"$decimal\"},child={name=\"var1.2\",exp=\"2\",numchild=\"1\",value=\"$hex\",type=\"bar.string_access\",thread-id=\"$decimal\"}\\\],has_more=\"0\"" \
+ "list var1's children"
+
+mi_gdb_test "-var-evaluate-expression var1" \
+ "\\^done,value=\"\\\[2\\\]\"" \
+ "Print var1"
+
+mi_gdb_test "-var-evaluate-expression var1.1" \
+ "\\^done,value=\"$hex\"" \
+ "Print var1 first child"
+
+mi_gdb_test "-var-evaluate-expression var1.2" \
+ "\\^done,value=\"$hex\"" \
+ "Print var1 second child"
diff --git a/gdb/testsuite/gdb.ada/mi_string_access/bar.adb b/gdb/testsuite/gdb.ada/mi_string_access/bar.adb
new file mode 100644
index 0000000..544376c
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/mi_string_access/bar.adb
@@ -0,0 +1,24 @@
+-- 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 String_Access is access String;
+ type Array_Of_String is array (1 .. 2) of String_Access;
+ Aos : Array_Of_String := (new String'("ab"), new String'("cd"));
+begin
+ Do_Nothing (Aos'Address); -- STOP
+end Bar;
diff --git a/gdb/testsuite/gdb.ada/mi_string_access/pck.adb b/gdb/testsuite/gdb.ada/mi_string_access/pck.adb
new file mode 100644
index 0000000..dcfb306
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/mi_string_access/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_string_access/pck.ads b/gdb/testsuite/gdb.ada/mi_string_access/pck.ads
new file mode 100644
index 0000000..33e369e
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/mi_string_access/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;