diff --git a/gdb/ChangeLog b/gdb/ChangeLog index 42ffaf7b86..4c2750ad28 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,9 @@ +2015-09-23 Pierre-Marie de Rodat + + * ada-lang.c (ada_evaluate_subexp) : When the input + value is a reference, actually dereference it in order to get + the underlying value. + 2015-09-22 Simon Marchi * stap-probe.c (handle_stap_probe): Remove unnecessary cast. diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c index 6ec2e9dfdb..8089a3228f 100644 --- a/gdb/ada-lang.c +++ b/gdb/ada-lang.c @@ -10642,10 +10642,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/ChangeLog b/gdb/testsuite/ChangeLog index 8cb1b7f84e..efabcdf671 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2015-09-23 Pierre-Marie de Rodat + + * 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. + 2015-09-21 Pierre Langlois * gdb.trace/ftrace-lock.c: New file. 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 0000000000..eece4a4386 --- /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\\) $hex.*" +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 0000000000..ead98bcd71 --- /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 0000000000..d88d046adf --- /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;