(Ada) fix handling of expression with parameterless function call

Consider the following function, which takes no parameter and returns
an integer:

    function Something return Integer;

For the purpose of this discussion, our function has been implemented
to always return 124:

    function Something return Integer is
    begin
       return 124;
    end Something;

In Ada, such function can been called without using the parentheses.
For instance, in the statement below, variable My_Value is assigned
the returned value from the call to Something:

    My_Value := Something;

The Ada expression interpeter in GDB supports this case, as we can
see below:

    (gdb) print something
    $1 = 124

However, we get fairly strange results when trying to use this feature
as part of a larger expression. For instance:

    (gdb) print something + 1
    $2 = 248

The problem occurs while doing the resolution pass of the expression.
After prefixying the expression, we obtain the following expression:

    0  BINOP_ADD
    1    OP_VAR_VALUE          Block @0x2021550, symbol @0x20213a0 (pck.something)
    5    OP_LONG               Type @0x1e3c170 (int), value 1 (0x1)

The resolution pass is then expected to remove the OP_VAR_VALUE
entry, and replace it with an OP_FUNCALL. This is what the call
to replace_operator_with_call in ada-lang.c::resolve_subexp is
expected to do:

      if (deprocedure_p
          && (TYPE_CODE (SYMBOL_TYPE (exp->elts[pc + 2].symbol))
              == TYPE_CODE_FUNC))
        {
          replace_operator_with_call (expp, pc, 0, 0,
                                      exp->elts[pc + 2].symbol,
                                      exp->elts[pc + 1].block);
          exp = expp->get ();
        }

The problem is that we're passing OPLEN (zero -- 4th parameter in
the call), and so replace_operator_with_call ends up removing zero
element from our expression, and inserting the corresponding OP_FUNCALL
instead. As a result, instead of having the OP_LONG (1) as the second
argument of the BINOP_ADD, it is now the OP_VAR_VALUE that we were
meant to replace. That OP_VAR_VALUE then itself gets transformed into
an OP_FUNCALL, with the same issue, and eventually, the resolved
expression now looks like this:

     0  BINOP_ADD
     1    OP_FUNCALL            Number of args: 0
     4      OP_VAR_VALUE          Block @0x2021550, symbol @0x20213a0 (pck.something)
     8    OP_FUNCALL            Number of args: 0
    11      OP_VAR_VALUE          Block @0x2021550, symbol @0x20213a0 (pck.something)
    15  OP_VAR_VALUE          Block @0x2021550, symbol @0x20213a0 (pck.something)
    19  OP_LONG               Type @0x1e3c170 (int), value 1 (0x1)

This explains why we get twice the result of the function call
instead of its value plus one. The extra entries in the expression
at the end are just ignored.

This patch fixes the issue by calling replace_operator_with_call
with the correct OPLEN equal to the size of an OP_VAR_VALUE (4).

gdb/ChangeLog:

        * ada-lang.c (resolve_subexp): Pass correct OPLEN in call to
        replace_operator_with_call.

gdb/testsuite/ChangeLog:

        * gdb.ada/expr_with_funcall: New testcase.

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index c3527dcfe101fd5c9b802a4fcb9ff2ad9f27bdb4..3247b66f6bb9e3e117d3c057a8a6688d93d859bb 100644 (file)
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,8 @@
+2018-09-08  Joel Brobecker  <brobecker@adacore.com>
+
+       * ada-lang.c (resolve_subexp): Pass correct OPLEN in call to
+       replace_operator_with_call.
+
 2018-09-08  Joel Brobecker  <brobecker@adacore.com>
 
        * ada-lang.c (ada_value_cast): Remove unnecessary parentheses.

diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index 0a73ca48a1607fa8132dd90feed5f79931bd9425..b8a11cdff2a933763aacd6bdb8c90d7c40400cd6 100644 (file)
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -3515,7 +3515,7 @@ resolve_subexp (expression_up *expp, int *pos, int deprocedure_p,
           && (TYPE_CODE (SYMBOL_TYPE (exp->elts[pc + 2].symbol))
               == TYPE_CODE_FUNC))
         {
-          replace_operator_with_call (expp, pc, 0, 0,
+          replace_operator_with_call (expp, pc, 0, 4,
                                       exp->elts[pc + 2].symbol,
                                       exp->elts[pc + 1].block);
           exp = expp->get ();

diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index e66747160283fe1b4c5bcdc82b2f8907f32adedb..02da57f7872bbe3d368ce71ab411dc360b18c448 100644 (file)
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2018-09-08  Joel Brobecker  <brobecker@adacore.com>
+
+       * gdb.ada/expr_with_funcall: New testcase.
+
 2018-09-08  Joel Brobecker  <brobecker@adacore.com>
 
        * gdb.ada/packed_array_assign: New testcase.

diff --git a/gdb/testsuite/gdb.ada/expr_with_funcall.exp b/gdb/testsuite/gdb.ada/expr_with_funcall.exp
new file mode 100644 (file)
index 0000000..77ad658
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/expr_with_funcall.exp
@@ -0,0 +1,52 @@
+# 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 expr_r821_013
+
+if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } {
+  return -1
+}
+
+clean_restart ${testfile}
+
+set bp_location [gdb_get_line_number "STOP" ${testdir}/expr_r821_013.adb]
+runto "expr_r821_013.adb:$bp_location"
+
+gdb_test "print something()"     " = 124"
+gdb_test "print something() + 1" " = 125"
+gdb_test "print something() - 2" " = 122"
+gdb_test "print something() * 3" " = 372"
+gdb_test "print something() / 4" " = 31"
+
+gdb_test "print 1 + something()"   " = 125"
+gdb_test "print 246 - something()" " = 122"
+gdb_test "print 3 * something()"   " = 372"
+gdb_test "print 496 / something()" " = 4"
+
+# Same as above, but without using the parentheses in the call to
+# function "Something".
+
+gdb_test "print something"     " = 124"
+gdb_test "print something + 1" " = 125"
+gdb_test "print something - 2" " = 122"
+gdb_test "print something * 3" " = 372"
+gdb_test "print something / 4" " = 31"
+
+gdb_test "print 1 + something"   " = 125"
+gdb_test "print 246 - something" " = 122"
+gdb_test "print 3 * something"   " = 372"
+gdb_test "print 496 / something" " = 4"

diff --git a/gdb/testsuite/gdb.ada/expr_with_funcall/expr_r821_013.adb b/gdb/testsuite/gdb.ada/expr_with_funcall/expr_r821_013.adb
new file mode 100644 (file)
index 0000000..98e9f2e
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/expr_with_funcall/expr_r821_013.adb
@@ -0,0 +1,23 @@
+--  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 Expr_R821_013 is
+   Val : Integer := Something;
+begin
+   Do_Nothing (Val'Address); -- STOP
+end Expr_R821_013;
+

diff --git a/gdb/testsuite/gdb.ada/expr_with_funcall/pck.adb b/gdb/testsuite/gdb.ada/expr_with_funcall/pck.adb
new file mode 100644 (file)
index 0000000..901b8db
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/expr_with_funcall/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
+   function Something return Integer is
+   begin
+      return 124;
+   end Something;
+
+   procedure Do_Nothing (A : System.Address) is
+   begin
+      null;
+   end Do_Nothing;
+end Pck;

diff --git a/gdb/testsuite/gdb.ada/expr_with_funcall/pck.ads b/gdb/testsuite/gdb.ada/expr_with_funcall/pck.ads
new file mode 100644 (file)
index 0000000..53cbe52
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/expr_with_funcall/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
+   function Something return Integer;
+   procedure Do_Nothing (A : System.Address);
+end Pck;