(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.
This commit is contained in:
Joel Brobecker 2018-09-08 16:51:36 -05:00
parent 95f39a5b27
commit 424da6cf3b
7 changed files with 131 additions and 1 deletions

View File

@ -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.

View File

@ -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 ();

View File

@ -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.

View File

@ -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"

View File

@ -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;

View File

@ -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;

View File

@ -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;