@@ -687,6 +687,10 @@ class ada_aggregate_component : public ada_component
{
}
+ /* 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,
@@ -698,6 +702,10 @@ class ada_aggregate_component : public ada_component
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;
};
@@ -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);
@@ -9321,10 +9321,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,
@@ -9361,6 +9360,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;
@@ -9371,6 +9372,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);
}
@@ -9381,12 +9387,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,
@@ -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" */
new file mode 100644
@@ -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"
new file mode 100644
@@ -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;
new file mode 100644
@@ -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;
new file mode 100644
@@ -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;