(Ada) -var-update crash for variable whose type is a reference to changeable

Consider the following variable, which is a string whose value
is not known at compile time, because it is the return value
from a function call (Get_Name):

   A : String := Get_Name;

If one tries to create a varobj for that variable, everything works
as expected:

    | (gdb) -var-create a * a
    | ^done,name="a",numchild="19",value="[19] \"Some kind of string\"",type="<ref> array (1 .. 19) of character",thread-id="1",has_more="0"

However, try then to request an update, regardless of whether the string
has changed or not, and we get a crash:

    | -var-update a
    | ~"/[...]/gdb/varobj.c:1379: internal-error: bool install_new_value(varobj*, value*, bool): Assertion `!value_lazy (var->value.get ())' failed.\nA problem internal to GDB has been detected,\nfurther debugging may prove unreliable.\nQuit this debugging session? (y or n) "

When the varobj gets created (-var-create), the expression is evaluated
and transformed into a value. The debugging information describes our
variables as a reference to an array of characters, so our value has
the corresponding type. We then call varobj.c::install_new_value
to store that value inside our varobj, and we see that this function
pretty starts by determining weither our varobj is changeable, via:

    | changeable = varobj_value_is_changeable_p (var);

(where 'var' is the varobj we are building, and where the function
varobj_value_is_changeable_p simply dispatches to the Ada version
of this routine: ada_value_is_changeable_p).

At this point, the varobj doesn't have a value, yet, but it does
have a type which was provided by varobj_create a little bit before
install_new_value was called. So ada_value_is_changeable_p uses that
to determine whether or not our type is changeable.

Since our type is a reference to an array, and that the value of
such objects is displayed as if there weren't a reference, it means
that our object is changeable -- in other words, if an element of
the string changes, then the "value" field of the varobj will change
accordingly. But unfortunately, ada_value_is_changeable_p mistakenly
returns false, because it is missing the handling of reference types.

As a consequence of this, install_new_value doesn't feel it is
necessary to fetch the value's contents, as explained by the following
comment inside that function:

  /* The new value might be lazy.  If the type is changeable,
     that is we'll be comparing values of this type, fetch the
     value now.  Otherwise, on the next update the old value
     will be lazy, which means we've lost that old value.  */

This means that a lazy value gets installed inside our varobj
as a result of the mistake in ada_value_is_changeable_p.

Another important detail is that, after determining whether
our varobj is changeable or not, it then purposefully removes
the reference layer from our value:

  /* We are not interested in the address of references, and given
     that in C++ a reference is not rebindable, it cannot
     meaningfully change.  So, get hold of the real value.  */
  if (value)
    value = coerce_ref (value);

The consequence of those two facts on shows up only later, when
the user requests an update (-var-update). When doing so, GDB
evaluates the expression again into a value which is once more
a reference to a string, and then calls install_new_value again
to install the new value and report any changes. This time around,
the call to...

    | changeable = varobj_value_is_changeable_p (var);

... now gets a varobj which has a value, and one which had the reference
layer removed! So, this time, we classify the varobj correctly, and
say it is changeable. And because it is changeable, we then go into
the section of code in install_new_value which checks for changes,
where we need the varobj's value to not be lazy, as explained by
the comment we quoted above. That's what the assertion was about.

This patch fixes the issues by teaching ada_value_is_changeable_p
to ignore reference layers when evaluating a given varobj's type.

gdb/ChangeLog:

	* ada-varobj.c (ada_value_is_changeable_p): Add handling of
        TYPE_CODE_REF types.

gdb/testsuite/ChangeLog:

        * gdb.ada/mi_ref_changeable: New testcase.

Prior to this patch, this testcase reports 2 unresolved tests
(due to GDB hitting the internal error). With this patch, all
tests in this testcase pass.

Tested on x86_64-linux, no regression.

7 files changed, 157 insertions, 0 deletions

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index de72773..3deb474 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,8 @@
+2019-02-10  Joel Brobecker  <brobecker@adacore.com>
+
+	* ada-varobj.c (ada_value_is_changeable_p): Add handling of
+	TYPE_CODE_REF types.
+
 2019-02-08  Jim Wilson  <jimw@sifive.com>
 
 	* riscv-linux-tdep.c (riscv_linux_fregmap): New.
diff --git a/gdb/ada-varobj.c b/gdb/ada-varobj.c
index 3b339e0..a4d553d 100644
--- a/gdb/ada-varobj.c
+++ b/gdb/ada-varobj.c
@@ -935,6 +935,9 @@ ada_value_is_changeable_p (const struct varobj *var)
   struct type *type = (var->value != nullptr
 		       ? value_type (var->value.get ()) : var->type);
 
+  if (TYPE_CODE (type) == TYPE_CODE_REF)
+    type = TYPE_TARGET_TYPE (type);
+
   if (ada_is_access_to_unconstrained_array (type))
     {
       /* This is in reality a pointer to an unconstrained array.
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index 1369b5a..d963997 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2019-02-10  Joel Brobecker  <brobecker@adacore.com>
+
+	* gdb.ada/mi_ref_changeable: New testcase.
+
 2019-02-07  Alan Hayward  <alan.hayward@arm.com>
 
 	* gdb.base/attach.exp: Add double attach test.
diff --git a/gdb/testsuite/gdb.ada/mi_ref_changeable.exp b/gdb/testsuite/gdb.ada/mi_ref_changeable.exp
new file mode 100644
index 0000000..933ad3e
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/mi_ref_changeable.exp
@@ -0,0 +1,71 @@
+# 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 foo_rb20_056
+
+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
+}
+
+# Continue until STOP_1, and create a varobj for variables "A" and "B".
+
+set bp_location [gdb_get_line_number "STOP_1" ${testdir}/foo_rb20_056.adb]
+mi_continue_to_line \
+    "foo_rb20_056.adb:$bp_location" \
+    "stop at STOP_1"
+
+mi_gdb_test "-var-create a * a" \
+    "\\^done,name=\"a\",numchild=\"19\",.*" \
+    "create varobj for a"
+
+mi_gdb_test "-var-create b * b" \
+    "\\^done,name=\"b\",numchild=\"19\",.*" \
+    "create varobj for b"
+
+# Continue until STOP_2, and request an update of varobjs a and b.
+# One should reported as changed (b), and the other should report
+# no change.
+
+set bp_location [gdb_get_line_number "STOP_2" ${testdir}/foo_rb20_056.adb]
+mi_continue_to_line \
+    "foo_rb20_056.adb:$bp_location" \
+    "stop at STOP_2"
+
+mi_gdb_test "-var-update a" \
+    "\\^done,changelist=\\\[\\\]" \
+    "-var-update a at STOP_2"
+
+mi_gdb_test "-var-update b" \
+    "\\^done,changelist=\\\[{name=\"b\".*}\\\]" \
+    "-var-update b at STOP_2"
diff --git a/gdb/testsuite/gdb.ada/mi_ref_changeable/foo_rb20_056.adb b/gdb/testsuite/gdb.ada/mi_ref_changeable/foo_rb20_056.adb
new file mode 100644
index 0000000..52975be
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/mi_ref_changeable/foo_rb20_056.adb
@@ -0,0 +1,28 @@
+--  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;
+with Pck; use Pck;
+
+procedure Foo_RB20_056 is
+   A : String := Get_Name;
+   B : String := Get_Name;
+begin
+   Do_Nothing (A'Address);
+   Do_Nothing (B'Address);
+   B (B'First) := 's'; -- STOP_1
+   Do_Nothing (A'Address); -- STOP_2
+   Do_Nothing (B'Address);
+end Foo_RB20_056;
diff --git a/gdb/testsuite/gdb.ada/mi_ref_changeable/pck.adb b/gdb/testsuite/gdb.ada/mi_ref_changeable/pck.adb
new file mode 100644
index 0000000..120052e
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/mi_ref_changeable/pck.adb
@@ -0,0 +1,26 @@
+--  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;
+
+   function Get_Name return String is
+   begin
+      return "Some kind of string";
+   end Get_Name;
+end Pck;
diff --git a/gdb/testsuite/gdb.ada/mi_ref_changeable/pck.ads b/gdb/testsuite/gdb.ada/mi_ref_changeable/pck.ads
new file mode 100644
index 0000000..0a96dfb
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/mi_ref_changeable/pck.ads
@@ -0,0 +1,20 @@
+--  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);
+   function Get_Name return String;
+end Pck;