riscv
/
binutils-gdb
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

Implement Ada 2022 delta aggregates 

Ada 2022 includes a "delta aggregates" feature that can sometimes
simplify aggregate creation.  This patch implements this feature for
GDB.
master
Tom Tromey 2 years ago
parent
7f032bbedf
commit
7e949f0870
8 changed files with 197 additions and 5 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 8
      gdb/ada-exp.h
  2. 12
      gdb/ada-exp.y
  3. 42
      gdb/ada-lang.c
  4. 2
      gdb/ada-lex.l
  5. 49
      gdb/testsuite/gdb.ada/delta-assign.exp
  6. 24
      gdb/testsuite/gdb.ada/delta-assign/main.adb
  7. 23
      gdb/testsuite/gdb.ada/delta-assign/pck.adb
  8. 42
      gdb/testsuite/gdb.ada/delta-assign/pck.ads

8
gdb/ada-exp.h
View File

@ -660,6 +660,10 @@ public:
{
}
/* This is the "with delta" form -- BASE is the base expression. */
ada_aggregate_component (operation_up &&base,
std::vector<ada_component_up> &&components);
void assign (struct value *container,
struct value *lhs, struct expression *exp,
std::vector<LONGEST> &indices,
@ -671,6 +675,10 @@ public:
private:
/* If the assignment has a "with delta" clause, this is the
base expression. */
operation_up m_base;
/* The individual components to assign. */
std::vector<ada_component_up> m_components;
};

12
gdb/ada-exp.y
View File

@ -453,6 +453,7 @@ static std::vector<ada_assign_up> assignments;
%token <typed_char> CHARLIT
%token <typed_val_float> FLOAT
%token TRUEKEYWORD FALSEKEYWORD
%token WITH DELTA
%token COLONCOLON
%token <sval> STRING NAME DOT_ID TICK_COMPLETE DOT_COMPLETE NAME_COMPLETE
%type <bval> block
@ -1032,7 +1033,16 @@ block : NAME COLONCOLON
;
aggregate :
'(' aggregate_component_list ')'
'(' exp WITH DELTA aggregate_component_list ')'
{
std::vector<ada_component_up> components
= pop_components ($5);
operation_up base = ada_pop ();
push_component<ada_aggregate_component>
(std::move (base), std::move (components));
}
| '(' aggregate_component_list ')'
{
std::vector<ada_component_up> components
= pop_components ($2);

42
gdb/ada-lang.c
View File

@ -9323,10 +9323,9 @@ check_objfile (const std::unique_ptr<ada_component> &comp,
return comp->uses_objfile (objfile);
}
/* Assign the result of evaluating ARG starting at *POS to the INDEXth
component of LHS (a simple array or a record). Does not modify the
inferior's memory, nor does it modify LHS (unless LHS ==
CONTAINER). */
/* Assign the result of evaluating ARG to the INDEXth component of LHS
(a simple array or a record). Does not modify the inferior's
memory, nor does it modify LHS (unless LHS == CONTAINER). */
static void
assign_component (struct value *container, struct value *lhs, LONGEST index,
@ -9363,6 +9362,8 @@ assign_component (struct value *container, struct value *lhs, LONGEST index,
bool
ada_aggregate_component::uses_objfile (struct objfile *objfile)
{
if (m_base != nullptr && m_base->uses_objfile (objfile))
return true;
for (const auto &item : m_components)
if (item->uses_objfile (objfile))
return true;
@ -9373,6 +9374,11 @@ void
ada_aggregate_component::dump (ui_file *stream, int depth)
{
gdb_printf (stream, _("%*sAggregate\n"), depth, "");
if (m_base != nullptr)
{
gdb_printf (stream, _("%*swith delta\n"), depth + 1, "");
m_base->dump (stream, depth + 2);
}
for (const auto &item : m_components)
item->dump (stream, depth + 1);
}
@ -9383,12 +9389,40 @@ ada_aggregate_component::assign (struct value *container,
std::vector<LONGEST> &indices,
LONGEST low, LONGEST high)
{
if (m_base != nullptr)
{
value *base = m_base->evaluate (nullptr, exp, EVAL_NORMAL);
if (ada_is_direct_array_type (base->type ()))
base = ada_coerce_to_simple_array (base);
if (!types_deeply_equal (container->type (), base->type ()))
error (_("Type mismatch in delta aggregate"));
value_assign_to_component (container, container, base);
}
for (auto &item : m_components)
item->assign (container, lhs, exp, indices, low, high);
}
/* See ada-exp.h. */
ada_aggregate_component::ada_aggregate_component
(operation_up &&base, std::vector<ada_component_up> &&components)
: m_base (std::move (base)),
m_components (std::move (components))
{
for (const auto &component : m_components)
if (dynamic_cast<const ada_others_component *> (component.get ())
!= nullptr)
{
/* It's invalid and nonsensical to have 'others => ...' with a
delta aggregate. It was simpler to enforce this
restriction here as opposed to in the parser. */
error (_("'others' invalid in delta aggregate"));
}
}
/* See ada-exp.h. */
value *
ada_aggregate_operation::assign_aggregate (struct value *container,
struct value *lhs,

2
gdb/ada-lex.l
View File

@ -225,6 +225,7 @@ thread{WHITE}+{DIG} {
abs { return ABS; }
and { return _AND_; }
delta { return DELTA; }
else { return ELSE; }
in { return IN; }
mod { return MOD; }
@ -235,6 +236,7 @@ or { return OR; }
others { return OTHERS; }
rem { return REM; }
then { return THEN; }
with { return WITH; }
xor { return XOR; }
/* BOOLEAN "KEYWORDS" */

49
gdb/testsuite/gdb.ada/delta-assign.exp
View File

@ -0,0 +1,49 @@
# Copyright 2024 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"
require allow_ada_tests
standard_ada_testfile main
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } {
return -1
}
clean_restart ${testfile}
set bp_location [gdb_get_line_number "STOP" ${testdir}/main.adb]
runto "main.adb:$bp_location"
gdb_test "print local := (pck.v1 with delta b => 23)" \
[string_to_regexp " = (a => 23, b => 23)"] \
"delta aggregate record"
gdb_test "print local := (pck.v1 with delta others => 23)" \
"'others' invalid in delta aggregate" \
"invalid record delta aggregate"
gdb_test "print local := (pck.v3 with delta b => 19)" \
"Type mismatch in delta aggregate" \
"wrong type in delta aggregate"
gdb_test "print a := (pck.a1 with delta 2 => 7)" \
[string_to_regexp " = (2, 7, 6)"] \
"delta aggregate array"
gdb_test "print a := (pck.a1 with delta others => 88)" \
"'others' invalid in delta aggregate" \
"invalid array delta aggregate"

24
gdb/testsuite/gdb.ada/delta-assign/main.adb
View File

@ -0,0 +1,24 @@
-- Copyright 2024 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 Main is
Local : Record_Type := (A => 1, B => 2);
A : Array_Type := (1, 3, 5);
begin
Do_Nothing (Local'Address); -- STOP
Do_Nothing (A'Address);
end Main;

23
gdb/testsuite/gdb.ada/delta-assign/pck.adb
View File

@ -0,0 +1,23 @@
-- Copyright 2024 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;

42
gdb/testsuite/gdb.ada/delta-assign/pck.ads
View File

@ -0,0 +1,42 @@
-- Copyright 2024 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
type Record_Type is record
A : Integer;
B : Integer;
end record;
V1 : Record_Type := (A => 23, B => 24);
V2 : Record_Type := (A => 47, B => 91);
type Other_Record_Type is record
A : Integer;
B : Integer;
C : Integer;
end record;
V3 : Other_Record_Type := (A => 47, B => 91, C => 102);
type Array_Type is array (1 .. 3) of Integer;
A1 : Array_Type := (2, 4, 6);
procedure Do_Nothing (A : System.Address);
end Pck;
Write Preview
Loading…
Cancel
Save