(Ada) problem printing renaming which references a subprogram parameter

Consider the following code, which creates a local variable B
which is a renaming whose expression references a subprogram
parameter:

   procedure Flip (Bits : in out Bits_Type; I : Natural) is
   begin
      declare
         B : Boolean renames Bits (I);
      begin
         B := not B; -- BREAK
      end;
   end Flip;

Trying to print the value of B when at the "BREAK" line currently
does not work:

    (gdb) p b
    Could not find i

What happens is the following: For the renaming, GNAT generates
a variable whose name is encoded as follow:

    b___XR_bits___XEXSi

GDB properly detects that variable, determines that, to compute
the variable's value, we start from the symbol "Bits", which
we then have to subscript (XS) using 'i' as the index. The error
occurs while trying to find 'i'.

This is because we forgot to pass the block in the call to
ada_lookup_encoded_symbol, which this patch fixes.

gdb/ChangeLog:

        * ada-exp.y (write_object_renaming): When subscripting an array
        using a symbol as the index, pass the block in call to
        ada_lookup_encoded_symbol when looking that symbol up.

gdb/testsuite/ChangeLog:

        * gdb.ada/rename_subscript_param: New testcase.

Tested on x86_64-linux.

Note: This requires the following GCC patch:

  | 2017-04-25  Pierre-Marie de Rodat  <derodat@adacore.com>
  |
  | * exp_dbug.adb: In Debug_Renaming_Declaration,
  | when dealing with indexed component, accept to produce a renaming
  | symbol when the index is an IN parameter or when it is a name
  | defined in an outer scope.
This commit is contained in:
Joel Brobecker 2018-01-05 04:29:54 -05:00
parent 7150d33cda
commit 342f824039
9 changed files with 169 additions and 2 deletions

View File

@ -1,3 +1,9 @@
2018-01-05 Joel Brobecker <brobecker@adacore.com>
* ada-exp.y (write_object_renaming): When subscripting an array
using a symbol as the index, pass the block in call to
ada_lookup_encoded_symbol when looking that symbol up.
2018-01-05 Jerome Guitton <guitton@adacore.com>
* ada-lang.c (ada_array_length): Use ada_index_type instead of

View File

@ -891,8 +891,8 @@ write_object_renaming (struct parser_state *par_state,
end - renaming_expr);
renaming_expr = end;
ada_lookup_encoded_symbol (index_name, NULL, VAR_DOMAIN,
&index_sym_info);
ada_lookup_encoded_symbol (index_name, orig_left_context,
VAR_DOMAIN, &index_sym_info);
if (index_sym_info.symbol == NULL)
error (_("Could not find %s"), index_name);
else if (SYMBOL_CLASS (index_sym_info.symbol) == LOC_TYPEDEF)

View File

@ -1,3 +1,7 @@
2018-01-05 Joel Brobecker <brobecker@adacore.com>
* gdb.ada/rename_subscript_param: New testcase.
2018-01-05 Jerome Guitton <guitton@adacore.com>
* gdb.ada/arr_acc_idx_w_gap: New testcase.

View File

@ -0,0 +1,44 @@
# Copyright 2016-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 pb30_012
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } {
return -1
}
clean_restart ${testfile}
set bp_location [gdb_get_line_number "BREAK" ${testdir}/pkg.adb]
runto "pkg.adb:$bp_location"
gdb_test "print b" \
" = false" \
"print b before changing its value"
set bp_location [gdb_get_line_number "Do_Nothing" ${testdir}/pkg.adb]
gdb_test "break pkg.adb:$bp_location" \
"Breakpoint \[0-9\]+ at.*: file .*pkg.adb, line \[0-9\]+." \
"insert second breakpoint in pkg.adb"
gdb_test "cont" \
"Breakpoint \[0-9\]+, pkg.flip \\(.*" \
"Continuing to breakpoint on call to Do_Nothing"
gdb_test "print b" \
" = true" \
"print b before changing its value"

View File

@ -0,0 +1,22 @@
-- Copyright 2016-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 Pkg; use Pkg;
procedure PB30_012 is
Bits : Bits_Type := (others => False);
begin
Flip (Bits, 2);
end PB30_012;

View File

@ -0,0 +1,21 @@
-- Copyright 2016-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;
end Pck;

View File

@ -0,0 +1,19 @@
-- Copyright 2016-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);
end Pck;

View File

@ -0,0 +1,30 @@
-- Copyright 2016-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;
package body Pkg is
procedure Flip (Bits : in out Bits_Type; I : Natural) is
begin
-- Create a new scope to check that the scope match algorithm is fine in
-- the front-end.
declare
B : Boolean renames Bits (I);
begin
B := not B; -- BREAK
Do_Nothing (Bits'Address);
end;
end Flip;
end Pkg;

View File

@ -0,0 +1,21 @@
-- Copyright 2016-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 Pkg is
type Bits_Type is array (1 .. 10) of Boolean
with Pack => True;
procedure Flip (Bits : in out Bits_Type; I : Natural);
end Pkg;