[commit/Ada] Wrong type description for tagged type parameter

[Joel Brobecker <brobecker at adacore dot com>]

Hello,

GDB prints the wrong type description when the object is a parameter
of a procedure where the parameter is declared as an abstract tagged
type (tagged types are the equivalent of C++ classes).  Consider the
following declarations:

        type Shape is abstract tagged record
          X, Y: Integer;
        end record;
        function Position_X (S : in Shape) return Integer;

In C++ parlance, these statements declare an abstract class called Shape,
and one associated method called Position_X.

Now, following those declarations, we have a class derivation:

        type Circle is new Shape with record
          R : Integer;
        end record;
        function Area (C : in Circle) return Integer;

In our example program, the code creates an object of type Circle,
and then calls Position_X with that object.  The user has a breakpoint
inside Position_X and is trying to print the type description of our
parameter:

        (gdb) ptype s
        type = <ref> tagged record
            x: integer;
            y: integer;
        end record

This is incorrect, since the actual type of our parameter is dynamic,
and should be shown as a child of type Shape:

        (gdb) ptype s
        type = new pck.shape with record
            r: integer;
        end record

The reason for the problem is that the debugger did not notice that
S was a tagged type simply because the parameter is a reference to
the abstract tagged type.  If there no reference indirection, I'm pretty
sure that the debugger would have printed the right type description.
This is confirmed by the following fix.

gdb/ChangeLog:

        * ada-lang.c (ada_evaluate_subexp) [OP_VAR_VALUE]: When noside is
        EVAL_AVOID_SIDE_EFFECTS, also handle the case when type is a
        reference to a tagged type.

gdb/testsuite/ChangeLog:

        * gdb.ada/ptype_tagged_param: New testcase.

Tested on x86_64-linux.

Will commit shortly,
-- 
Joel

---
 gdb/ada-lang.c                                   |    9 ++++-
 gdb/testsuite/gdb.ada/ptype_tagged_param.exp     |   47 ++++++++++++++++++++++
 gdb/testsuite/gdb.ada/ptype_tagged_param/foo.adb |   23 +++++++++++
 gdb/testsuite/gdb.ada/ptype_tagged_param/pck.adb |   30 ++++++++++++++
 gdb/testsuite/gdb.ada/ptype_tagged_param/pck.ads |   29 +++++++++++++
 5 files changed, 137 insertions(+), 1 deletions(-)
 create mode 100644 gdb/testsuite/gdb.ada/ptype_tagged_param.exp
 create mode 100644 gdb/testsuite/gdb.ada/ptype_tagged_param/foo.adb
 create mode 100644 gdb/testsuite/gdb.ada/ptype_tagged_param/pck.adb
 create mode 100644 gdb/testsuite/gdb.ada/ptype_tagged_param/pck.ads

diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index 40b70ab..7a2d2ca 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -8906,7 +8906,14 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
         {
           type = static_unwrap_type (SYMBOL_TYPE (exp->elts[pc + 2].symbol));
-          if (ada_is_tagged_type (type, 0))
+          /* Check to see if this is a tagged type.  We also need to handle
+             the case where the type is a reference to a tagged type, but
+             we have to be careful to exclude pointers to tagged types.
+             The latter should be shown as usual (as a pointer), whereas
+             a reference should mostly be transparent to the user.  */
+          if (ada_is_tagged_type (type, 0)
+              || (TYPE_CODE(type) == TYPE_CODE_REF
+                  && ada_is_tagged_type (TYPE_TARGET_TYPE (type), 0)))
           {
             /* Tagged types are a little special in the fact that the real
                type is dynamic and can only be determined by inspecting the
diff --git a/gdb/testsuite/gdb.ada/ptype_tagged_param.exp b/gdb/testsuite/gdb.ada/ptype_tagged_param.exp
new file mode 100644
index 0000000..39b64d5
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/ptype_tagged_param.exp
@@ -0,0 +1,47 @@
+# Copyright 2010 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/>.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+load_lib "ada.exp"
+
+set testdir "ptype_tagged_param"
+set testfile "${testdir}/foo"
+set srcfile ${srcdir}/${subdir}/${testfile}.adb
+set binfile ${objdir}/${subdir}/${testfile}
+
+file mkdir ${objdir}/${subdir}/${testdir}
+if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } {
+  return -1
+}
+
+gdb_exit
+gdb_start
+gdb_reinitialize_dir $srcdir/$subdir
+gdb_load ${binfile}
+
+if ![runto "position_x" ] then {
+  return -1
+}
+
+set eol "\[\r\n\]+"
+set sp "\[ \t\]*"
+
+gdb_test "ptype s" \
+         "type = new pck.shape with record${eol}${sp}r: integer;${eol}end record" \
+         "ptype s"
+
diff --git a/gdb/testsuite/gdb.ada/ptype_tagged_param/foo.adb b/gdb/testsuite/gdb.ada/ptype_tagged_param/foo.adb
new file mode 100644
index 0000000..3a12453
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/ptype_tagged_param/foo.adb
@@ -0,0 +1,23 @@
+--  Copyright 2010 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 Foo is
+   My_Shape : Circle := (X => 1, Y => 2, R => 3);
+   X : Integer;
+begin
+   X := Position_X (My_Shape);
+end Foo;
diff --git a/gdb/testsuite/gdb.ada/ptype_tagged_param/pck.adb b/gdb/testsuite/gdb.ada/ptype_tagged_param/pck.adb
new file mode 100644
index 0000000..e54bcb1
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/ptype_tagged_param/pck.adb
@@ -0,0 +1,30 @@
+--  Copyright 2010 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
+
+   function Position_X (S : in Shape) return Integer is
+   begin
+      return S.X;
+   end Position_X;
+
+   function Area (C : in Circle) return Integer is
+   begin
+      --  Very crude calculation...
+      return 6 * C.R * C.R;
+   end Area;
+
+end Pck;
+
diff --git a/gdb/testsuite/gdb.ada/ptype_tagged_param/pck.ads b/gdb/testsuite/gdb.ada/ptype_tagged_param/pck.ads
new file mode 100644
index 0000000..8d8f1d0
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/ptype_tagged_param/pck.ads
@@ -0,0 +1,29 @@
+--  Copyright 2010 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 Pck is
+
+   type Shape is abstract tagged record
+     X, Y: Integer;
+   end record;
+   function Position_X (S : in Shape) return Integer;
+
+   type Circle is new Shape with record
+     R : Integer;
+   end record;
+   function Area (C : in Circle) return Integer;
+
+end Pck;
+
-- 
1.6.3.3