* [PATCH 1/5] Fix bug in Ada aggregate assignment
2021-03-10 17:56 [PATCH 0/5] Fix Ada expression regressions Tom Tromey
@ 2021-03-10 17:56 ` Tom Tromey
2021-03-10 17:56 ` [PATCH 2/5] Fix Ada assignment resolution Tom Tromey
` (4 subsequent siblings)
5 siblings, 0 replies; 7+ messages in thread
From: Tom Tromey @ 2021-03-10 17:56 UTC (permalink / raw)
To: gdb-patches; +Cc: Tom Tromey
The expression rewrite caused a regression in the internal AdaCore
test suite. The bug was that I had dropped a bit of code from
aggregate assignment -- assign_aggregate used to return the container,
which I thought was redundant, but which can actually change during
the call. There was no test for this case in the tree, so I've added
one.
gdb/ChangeLog
2021-03-10 Tom Tromey <tromey@adacore.com>
* ada-lang.c (ada_aggregate_operation::assign_aggregate): Return
container.
(ada_assign_operation::evaluate): Update.
* ada-exp.h (class ada_aggregate_operation) <assign_aggregate>:
Change return type.
gdb/testsuite/ChangeLog
2021-03-10 Tom Tromey <tromey@adacore.com>
* gdb.ada/assign_arr/target_wrapper.ads (IArray, Put, Do_Nothing):
Declare.
* gdb.ada/assign_arr/target_wrapper.adb: New file.
* gdb.ada/assign_arr/main_p324_051.adb (IValue): New variable.
Call Put.
* gdb.ada/assign_arr.exp: Update.
---
gdb/ChangeLog | 8 ++++++
gdb/ada-exp.h | 9 +++---
gdb/ada-lang.c | 12 ++++----
gdb/testsuite/ChangeLog | 9 ++++++
gdb/testsuite/gdb.ada/assign_arr.exp | 7 +++++
.../gdb.ada/assign_arr/main_p324_051.adb | 2 ++
.../gdb.ada/assign_arr/target_wrapper.adb | 28 +++++++++++++++++++
.../gdb.ada/assign_arr/target_wrapper.ads | 8 ++++++
8 files changed, 72 insertions(+), 11 deletions(-)
create mode 100644 gdb/testsuite/gdb.ada/assign_arr/target_wrapper.adb
diff --git a/gdb/ada-exp.h b/gdb/ada-exp.h
index 0b6f1f22e79..82941dd0634 100644
--- a/gdb/ada-exp.h
+++ b/gdb/ada-exp.h
@@ -510,11 +510,12 @@ class ada_aggregate_operation
type, evaluate an assignment of this aggregate's value to LHS.
CONTAINER is an lvalue containing LHS (possibly LHS itself).
Does not modify the inferior's memory, nor does it modify the
- contents of LHS (unless == CONTAINER). */
+ contents of LHS (unless == CONTAINER). Returns the modified
+ CONTAINER. */
- void assign_aggregate (struct value *container,
- struct value *lhs,
- struct expression *exp);
+ value *assign_aggregate (struct value *container,
+ struct value *lhs,
+ struct expression *exp);
value *evaluate (struct type *expect_type,
struct expression *exp,
diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index 8330cbcc0b9..7e53ae07c18 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -9101,13 +9101,9 @@ ada_aggregate_component::assign (struct value *container,
item->assign (container, lhs, exp, indices, low, high);
}
-/* Assuming that LHS represents an lvalue having a record or array
- type, evaluate an assignment of this aggregate's value to LHS.
- CONTAINER is an lvalue containing LHS (possibly LHS itself). Does
- not modify the inferior's memory, nor does it modify the contents
- of LHS (unless == CONTAINER). */
+/* See ada-exp.h. */
-void
+value *
ada_aggregate_operation::assign_aggregate (struct value *container,
struct value *lhs,
struct expression *exp)
@@ -9144,6 +9140,8 @@ ada_aggregate_operation::assign_aggregate (struct value *container,
std::get<0> (m_storage)->assign (container, lhs, exp, indices,
low_index, high_index);
+
+ return container;
}
bool
@@ -9349,7 +9347,7 @@ ada_assign_operation::evaluate (struct type *expect_type,
if (noside != EVAL_NORMAL)
return arg1;
- ag_op->assign_aggregate (arg1, arg1, exp);
+ arg1 = ag_op->assign_aggregate (arg1, arg1, exp);
return ada_value_assign (arg1, arg1);
}
/* Force the evaluation of the rhs ARG2 to the type of the lhs ARG1,
diff --git a/gdb/testsuite/gdb.ada/assign_arr.exp b/gdb/testsuite/gdb.ada/assign_arr.exp
index ca894f057e2..08090271afc 100644
--- a/gdb/testsuite/gdb.ada/assign_arr.exp
+++ b/gdb/testsuite/gdb.ada/assign_arr.exp
@@ -33,3 +33,10 @@ gdb_test "print assign_arr_input.u2 :=(0.25,0.5,0.75)" \
gdb_test "print assign_arr_input.u2 :=(0.25, others => 0.125)" \
" = \\(0\\.25, 0\\.125, 0\\.125\\)"
+
+set line [gdb_get_line_number "STOP2" ${testdir}/target_wrapper.adb]
+gdb_breakpoint target_wrapper.adb:$line
+gdb_continue_to_breakpoint STOP2
+
+gdb_test "print a" " = \\(8, 10, 12\\)"
+gdb_test "print a := (2, 4, 6)" " = \\(2, 4, 6\\)" "assign to a"
diff --git a/gdb/testsuite/gdb.ada/assign_arr/main_p324_051.adb b/gdb/testsuite/gdb.ada/assign_arr/main_p324_051.adb
index f140118704e..f352d91cdf9 100644
--- a/gdb/testsuite/gdb.ada/assign_arr/main_p324_051.adb
+++ b/gdb/testsuite/gdb.ada/assign_arr/main_p324_051.adb
@@ -16,6 +16,8 @@
with target_wrapper; use target_wrapper;
procedure Main_P324_051 is
+ IValue : IArray (1 .. 3) := (8, 10, 12);
begin
Assign_Arr_Input.u2 := (0.2,0.3,0.4); -- STOP
+ Put (IValue);
end Main_P324_051;
diff --git a/gdb/testsuite/gdb.ada/assign_arr/target_wrapper.adb b/gdb/testsuite/gdb.ada/assign_arr/target_wrapper.adb
new file mode 100644
index 00000000000..888c5e4a5c3
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/assign_arr/target_wrapper.adb
@@ -0,0 +1,28 @@
+-- Copyright 2021 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 target_wrapper is
+
+ procedure Do_Nothing (A : System.Address) is
+ begin
+ null;
+ end Do_Nothing;
+
+ procedure Put (A : in out IArray) is
+ begin
+ Do_Nothing (A'Address); -- STOP2
+ end Put;
+
+end target_wrapper;
diff --git a/gdb/testsuite/gdb.ada/assign_arr/target_wrapper.ads b/gdb/testsuite/gdb.ada/assign_arr/target_wrapper.ads
index 24bb1f56e4a..743964a2ecd 100644
--- a/gdb/testsuite/gdb.ada/assign_arr/target_wrapper.ads
+++ b/gdb/testsuite/gdb.ada/assign_arr/target_wrapper.ads
@@ -13,6 +13,8 @@
-- 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 target_wrapper is
type Float_Array_3 is array (1 .. 3) of Float;
@@ -23,4 +25,10 @@ package target_wrapper is
Assign_Arr_Input : parameters;
+ type IArray is array (Integer range <>) of Integer;
+
+ procedure Put (A : in out IArray);
+
+ procedure Do_Nothing (A : System.Address);
+
end target_wrapper;
--
2.26.2
^ permalink raw reply [flat|nested] 7+ messages in thread* [PATCH 2/5] Fix Ada assignment resolution
2021-03-10 17:56 [PATCH 0/5] Fix Ada expression regressions Tom Tromey
2021-03-10 17:56 ` [PATCH 1/5] Fix bug in Ada aggregate assignment Tom Tromey
@ 2021-03-10 17:56 ` Tom Tromey
2021-03-10 17:56 ` [PATCH 3/5] Fix regression in Ada ptype Tom Tromey
` (3 subsequent siblings)
5 siblings, 0 replies; 7+ messages in thread
From: Tom Tromey @ 2021-03-10 17:56 UTC (permalink / raw)
To: gdb-patches; +Cc: Tom Tromey
The expression rewrite missed an Ada resolution case. GDB previously
knew how to disambiguate the right hand side of an assignment, but now
it does not.
This patch fixes the problem and adds the missing test case.
gdb/ChangeLog
2021-03-10 Tom Tromey <tromey@adacore.com>
* ada-exp.y (exp1): Handle resolution of the right hand side of an
assignment.
gdb/testsuite/ChangeLog
2021-03-10 Tom Tromey <tromey@adacore.com>
* gdb.ada/enums_overload/enums_overload_main.adb: New file.
* gdb.ada/enums_overload/enums_overload.ads: New file.
* gdb.ada/enums_overload/enums_overload.adb: New file.
* gdb.ada/enums_overload.exp: New file.
---
gdb/ChangeLog | 5 +++
gdb/ada-exp.y | 12 +++++-
gdb/testsuite/ChangeLog | 7 ++++
gdb/testsuite/gdb.ada/enums_overload.exp | 37 ++++++++++++++++++
.../gdb.ada/enums_overload/enums_overload.adb | 38 +++++++++++++++++++
.../gdb.ada/enums_overload/enums_overload.ads | 24 ++++++++++++
.../enums_overload/enums_overload_main.adb | 20 ++++++++++
7 files changed, 142 insertions(+), 1 deletion(-)
create mode 100644 gdb/testsuite/gdb.ada/enums_overload.exp
create mode 100644 gdb/testsuite/gdb.ada/enums_overload/enums_overload.adb
create mode 100644 gdb/testsuite/gdb.ada/enums_overload/enums_overload.ads
create mode 100644 gdb/testsuite/gdb.ada/enums_overload/enums_overload_main.adb
diff --git a/gdb/ada-exp.y b/gdb/ada-exp.y
index 222fec536f3..4300907685c 100644
--- a/gdb/ada-exp.y
+++ b/gdb/ada-exp.y
@@ -413,7 +413,17 @@ exp1 : exp
| exp1 ';' exp
{ ada_wrap2<comma_operation> (); }
| primary ASSIGN exp /* Extension for convenience */
- { ada_wrap2<ada_assign_operation> (); }
+ {
+ operation_up rhs = pstate->pop ();
+ operation_up lhs = ada_pop ();
+ value *lhs_val
+ = lhs->evaluate (nullptr, pstate->expout.get (),
+ EVAL_AVOID_SIDE_EFFECTS);
+ rhs = resolve (std::move (rhs), true,
+ value_type (lhs_val));
+ pstate->push_new<ada_assign_operation>
+ (std::move (lhs), std::move (rhs));
+ }
;
/* Expressions, not including the sequencing operator. */
diff --git a/gdb/testsuite/gdb.ada/enums_overload.exp b/gdb/testsuite/gdb.ada/enums_overload.exp
new file mode 100644
index 00000000000..165ee1e1147
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/enums_overload.exp
@@ -0,0 +1,37 @@
+# Copyright 2021 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"
+
+if { [skip_ada_tests] } { return -1 }
+
+standard_ada_testfile enums_overload_main
+
+if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } {
+ return -1
+}
+
+clean_restart ${testfile}
+
+set bp_location [gdb_get_line_number "STOP" ${testdir}/enums_overload.adb]
+runto "enums_overload.adb:$bp_location"
+
+gdb_test "ptype x" "type = range red \\.\\. yellow"
+gdb_test "print x := red" " = red"
+gdb_test "print x" " = red"
+gdb_test "print enums_overload.reddish'(red)" " = red" \
+ "function call disambiguates enum"
+gdb_test "print y := red" " = red"
+gdb_test "print y" " = red"
diff --git a/gdb/testsuite/gdb.ada/enums_overload/enums_overload.adb b/gdb/testsuite/gdb.ada/enums_overload/enums_overload.adb
new file mode 100644
index 00000000000..a245d58b24d
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/enums_overload/enums_overload.adb
@@ -0,0 +1,38 @@
+-- Copyright 2021 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 Enums_Overload is
+
+ subtype Reddish is Color range Red .. Yellow;
+
+ procedure Test_Enums_Overload is
+ X: Reddish := Orange;
+ Y: Traffic_Signal := Yellow;
+ begin
+ --gdb: next
+ X := Orange;
+ --gdb: next
+ Y := Yellow;
+ --gdb: ptype x range red .. yellow
+ --gdb: set x := red
+ --gdb: print x red
+ --gdb: print enums_overload.reddish'(red) red
+ --gdb: set y := red
+ --gdb: print y red
+ --gdb: cont
+ null; -- STOP
+ end Test_Enums_Overload;
+
+end Enums_Overload;
diff --git a/gdb/testsuite/gdb.ada/enums_overload/enums_overload.ads b/gdb/testsuite/gdb.ada/enums_overload/enums_overload.ads
new file mode 100644
index 00000000000..f3158fa1509
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/enums_overload/enums_overload.ads
@@ -0,0 +1,24 @@
+-- Copyright 2021 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 Enums_Overload is
+
+ type Color is (Red, Orange, Yellow, Green, Blue, Violet, Indigo);
+
+ type Traffic_Signal is (Green, Yellow, Red);
+
+ procedure Test_Enums_Overload;
+
+end Enums_Overload;
diff --git a/gdb/testsuite/gdb.ada/enums_overload/enums_overload_main.adb b/gdb/testsuite/gdb.ada/enums_overload/enums_overload_main.adb
new file mode 100644
index 00000000000..954243337ec
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/enums_overload/enums_overload_main.adb
@@ -0,0 +1,20 @@
+-- Copyright 2021 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 Enums_Overload;
+procedure Enums_Overload_Main is
+begin
+ Enums_Overload.Test_Enums_Overload;
+end Enums_Overload_Main;
--
2.26.2
^ permalink raw reply [flat|nested] 7+ messages in thread* [PATCH 4/5] Implement Ada operator overloading
2021-03-10 17:56 [PATCH 0/5] Fix Ada expression regressions Tom Tromey
` (2 preceding siblings ...)
2021-03-10 17:56 ` [PATCH 3/5] Fix regression in Ada ptype Tom Tromey
@ 2021-03-10 17:56 ` Tom Tromey
2021-03-10 17:56 ` [PATCH 5/5] Call ada_ensure_varsize_limit in indirection Tom Tromey
2021-03-15 12:38 ` [PATCH 0/5] Fix Ada expression regressions Tom Tromey
5 siblings, 0 replies; 7+ messages in thread
From: Tom Tromey @ 2021-03-10 17:56 UTC (permalink / raw)
To: gdb-patches; +Cc: Tom Tromey
In the expression rewrite, I neglected to carry over support for Ada
operator overloading. It turns out that there were no tests for this
in-tree.
This patch adds support for operator overloading, and adds the missing
test.
gdb/ChangeLog
2021-03-10 Tom Tromey <tromey@adacore.com>
* ada-lang.c (numeric_type_p, integer_type_p): Return true for
fixed-point.
* ada-exp.y (maybe_overload): New function.
(ada_wrap_overload): New function.
(ada_un_wrap2, ada_wrap2, ada_wrap_op): Use maybe_overload.
(exp1, simple_exp, relation, and_exp, and_then_exp, or_exp)
(or_else_exp, xor_exp, primary): Update.
gdb/testsuite/ChangeLog
2021-03-10 Tom Tromey <tromey@adacore.com>
* gdb.ada/operator_call/twovecs.ads: New file.
* gdb.ada/operator_call/twovecs.adb: New file.
* gdb.ada/operator_call/opcall.adb: New file.
* gdb.ada/operator_call.exp: New file.
---
gdb/ChangeLog | 10 ++
gdb/ada-exp.y | 155 ++++++++++++++----
gdb/ada-lang.c | 2 +
gdb/testsuite/ChangeLog | 7 +
gdb/testsuite/gdb.ada/operator_call.exp | 115 +++++++++++++
.../gdb.ada/operator_call/opcall.adb | 25 +++
.../gdb.ada/operator_call/twovecs.adb | 133 +++++++++++++++
.../gdb.ada/operator_call/twovecs.ads | 55 +++++++
8 files changed, 467 insertions(+), 35 deletions(-)
create mode 100644 gdb/testsuite/gdb.ada/operator_call.exp
create mode 100644 gdb/testsuite/gdb.ada/operator_call/opcall.adb
create mode 100644 gdb/testsuite/gdb.ada/operator_call/twovecs.adb
create mode 100644 gdb/testsuite/gdb.ada/operator_call/twovecs.ads
diff --git a/gdb/ada-exp.y b/gdb/ada-exp.y
index 4300907685c..e8ffb8e1040 100644
--- a/gdb/ada-exp.y
+++ b/gdb/ada-exp.y
@@ -166,17 +166,77 @@ ada_addrof (struct type *type = nullptr)
pstate->push (std::move (wrapped));
}
+/* Handle operator overloading. Either returns a function all
+ operation wrapping the arguments, or it returns null, leaving the
+ caller to construct the appropriate operation. If RHS is null, a
+ unary operator is assumed. */
+static operation_up
+maybe_overload (enum exp_opcode op, operation_up &lhs, operation_up &rhs)
+{
+ struct value *args[2];
+
+ int nargs = 1;
+ args[0] = lhs->evaluate (nullptr, pstate->expout.get (),
+ EVAL_AVOID_SIDE_EFFECTS);
+ if (rhs == nullptr)
+ args[1] = nullptr;
+ else
+ {
+ args[1] = rhs->evaluate (nullptr, pstate->expout.get (),
+ EVAL_AVOID_SIDE_EFFECTS);
+ ++nargs;
+ }
+
+ block_symbol fn = ada_find_operator_symbol (op, pstate->parse_completion,
+ nargs, args);
+ if (fn.symbol == nullptr)
+ return {};
+
+ if (symbol_read_needs_frame (fn.symbol))
+ pstate->block_tracker->update (fn.block, INNERMOST_BLOCK_FOR_SYMBOLS);
+ operation_up callee
+ = make_operation<ada_var_value_operation> (fn.symbol, fn.block);
+
+ std::vector<operation_up> argvec;
+ argvec.push_back (std::move (lhs));
+ if (rhs != nullptr)
+ argvec.push_back (std::move (rhs));
+ return make_operation<ada_funcall_operation> (std::move (callee),
+ std::move (argvec));
+}
+
+/* Like parser_state::wrap, but use ada_pop to pop the value, and
+ handle unary overloading. */
+template<typename T>
+void
+ada_wrap_overload (enum exp_opcode op)
+{
+ operation_up arg = ada_pop ();
+ operation_up empty;
+
+ operation_up call = maybe_overload (op, arg, empty);
+ if (call == nullptr)
+ call = make_operation<T> (std::move (arg));
+ pstate->push (std::move (call));
+}
+
/* A variant of parser_state::wrap2 that uses ada_pop to pop both
operands, and then pushes a new Ada-wrapped operation of the
template type T. */
template<typename T>
void
-ada_un_wrap2 ()
+ada_un_wrap2 (enum exp_opcode op)
{
operation_up rhs = ada_pop ();
operation_up lhs = ada_pop ();
- operation_up wrapped = make_operation<T> (std::move (lhs), std::move (rhs));
- pstate->push_new<ada_wrapped_operation> (std::move (wrapped));
+
+ operation_up wrapped = maybe_overload (op, lhs, rhs);
+ if (wrapped == nullptr)
+ {
+ wrapped = make_operation<T> (std::move (lhs), std::move (rhs));
+ wrapped = make_operation<ada_wrapped_operation> (std::move (wrapped));
+ }
+ pstate->push (std::move (wrapped));
}
/* A variant of parser_state::wrap2 that uses ada_pop to pop both
@@ -184,11 +244,14 @@ ada_un_wrap2 ()
used. */
template<typename T>
void
-ada_wrap2 ()
+ada_wrap2 (enum exp_opcode op)
{
operation_up rhs = ada_pop ();
operation_up lhs = ada_pop ();
- pstate->push_new<T> (std::move (lhs), std::move (rhs));
+ operation_up call = maybe_overload (op, lhs, rhs);
+ if (call == nullptr)
+ call = make_operation<T> (std::move (lhs), std::move (rhs));
+ pstate->push (std::move (call));
}
/* A variant of parser_state::wrap2 that uses ada_pop to pop both
@@ -200,7 +263,10 @@ ada_wrap_op (enum exp_opcode op)
{
operation_up rhs = ada_pop ();
operation_up lhs = ada_pop ();
- pstate->push_new<T> (op, std::move (lhs), std::move (rhs));
+ operation_up call = maybe_overload (op, lhs, rhs);
+ if (call == nullptr)
+ call = make_operation<T> (op, std::move (lhs), std::move (rhs));
+ pstate->push (std::move (call));
}
/* Pop three operands using ada_pop, then construct a new ternary
@@ -411,7 +477,7 @@ start : exp1
/* Expressions, including the sequencing operator. */
exp1 : exp
| exp1 ';' exp
- { ada_wrap2<comma_operation> (); }
+ { ada_wrap2<comma_operation> (BINOP_COMMA); }
| primary ASSIGN exp /* Extension for convenience */
{
operation_up rhs = pstate->pop ();
@@ -515,21 +581,32 @@ simple_exp : primary
;
simple_exp : '-' simple_exp %prec UNARY
- { ada_wrap<ada_neg_operation> (); }
+ { ada_wrap_overload<ada_neg_operation> (UNOP_NEG); }
;
simple_exp : '+' simple_exp %prec UNARY
{
- /* No need to do anything. */
+ operation_up arg = ada_pop ();
+ operation_up empty;
+
+ /* We only need to handle the overloading
+ case here, not anything else. */
+ operation_up call = maybe_overload (UNOP_PLUS, arg,
+ empty);
+ if (call != nullptr)
+ pstate->push (std::move (call));
}
;
simple_exp : NOT simple_exp %prec UNARY
- { ada_wrap<unary_logical_not_operation> (); }
+ {
+ ada_wrap_overload<unary_logical_not_operation>
+ (UNOP_LOGICAL_NOT);
+ }
;
simple_exp : ABS simple_exp %prec UNARY
- { ada_wrap<ada_abs_operation> (); }
+ { ada_wrap_overload<ada_abs_operation> (UNOP_ABS); }
;
arglist : { $$ = 0; }
@@ -559,27 +636,27 @@ primary : '{' var_or_type '}' primary %prec '.'
/* Binary operators in order of decreasing precedence. */
simple_exp : simple_exp STARSTAR simple_exp
- { ada_wrap2<ada_binop_exp_operation> (); }
+ { ada_wrap2<ada_binop_exp_operation> (BINOP_EXP); }
;
simple_exp : simple_exp '*' simple_exp
- { ada_wrap2<ada_binop_mul_operation> (); }
+ { ada_wrap2<ada_binop_mul_operation> (BINOP_MUL); }
;
simple_exp : simple_exp '/' simple_exp
- { ada_wrap2<ada_binop_div_operation> (); }
+ { ada_wrap2<ada_binop_div_operation> (BINOP_DIV); }
;
simple_exp : simple_exp REM simple_exp /* May need to be fixed to give correct Ada REM */
- { ada_wrap2<ada_binop_rem_operation> (); }
+ { ada_wrap2<ada_binop_rem_operation> (BINOP_REM); }
;
simple_exp : simple_exp MOD simple_exp
- { ada_wrap2<ada_binop_mod_operation> (); }
+ { ada_wrap2<ada_binop_mod_operation> (BINOP_MOD); }
;
simple_exp : simple_exp '@' simple_exp /* GDB extension */
- { ada_wrap2<repeat_operation> (); }
+ { ada_wrap2<repeat_operation> (BINOP_REPEAT); }
;
simple_exp : simple_exp '+' simple_exp
@@ -587,7 +664,7 @@ simple_exp : simple_exp '+' simple_exp
;
simple_exp : simple_exp '&' simple_exp
- { ada_wrap2<concat_operation> (); }
+ { ada_wrap2<concat_operation> (BINOP_CONCAT); }
;
simple_exp : simple_exp '-' simple_exp
@@ -606,7 +683,7 @@ relation : simple_exp NOTEQUAL simple_exp
;
relation : simple_exp LEQ simple_exp
- { ada_un_wrap2<leq_operation> (); }
+ { ada_un_wrap2<leq_operation> (BINOP_LEQ); }
;
relation : simple_exp IN simple_exp DOTDOT simple_exp
@@ -649,15 +726,15 @@ relation : simple_exp IN simple_exp DOTDOT simple_exp
;
relation : simple_exp GEQ simple_exp
- { ada_un_wrap2<geq_operation> (); }
+ { ada_un_wrap2<geq_operation> (BINOP_GEQ); }
;
relation : simple_exp '<' simple_exp
- { ada_un_wrap2<less_operation> (); }
+ { ada_un_wrap2<less_operation> (BINOP_LESS); }
;
relation : simple_exp '>' simple_exp
- { ada_un_wrap2<gtr_operation> (); }
+ { ada_un_wrap2<gtr_operation> (BINOP_GTR); }
;
exp : relation
@@ -670,36 +747,44 @@ exp : relation
and_exp :
relation _AND_ relation
- { ada_wrap2<ada_bitwise_and_operation> (); }
+ { ada_wrap2<ada_bitwise_and_operation>
+ (BINOP_BITWISE_AND); }
| and_exp _AND_ relation
- { ada_wrap2<ada_bitwise_and_operation> (); }
+ { ada_wrap2<ada_bitwise_and_operation>
+ (BINOP_BITWISE_AND); }
;
and_then_exp :
relation _AND_ THEN relation
- { ada_wrap2<logical_and_operation> (); }
+ { ada_wrap2<logical_and_operation>
+ (BINOP_LOGICAL_AND); }
| and_then_exp _AND_ THEN relation
- { ada_wrap2<logical_and_operation> (); }
+ { ada_wrap2<logical_and_operation>
+ (BINOP_LOGICAL_AND); }
;
or_exp :
relation OR relation
- { ada_wrap2<ada_bitwise_ior_operation> (); }
+ { ada_wrap2<ada_bitwise_ior_operation>
+ (BINOP_BITWISE_IOR); }
| or_exp OR relation
- { ada_wrap2<ada_bitwise_ior_operation> (); }
+ { ada_wrap2<ada_bitwise_ior_operation>
+ (BINOP_BITWISE_IOR); }
;
or_else_exp :
relation OR ELSE relation
- { ada_wrap2<logical_or_operation> (); }
+ { ada_wrap2<logical_or_operation> (BINOP_LOGICAL_OR); }
| or_else_exp OR ELSE relation
- { ada_wrap2<logical_or_operation> (); }
+ { ada_wrap2<logical_or_operation> (BINOP_LOGICAL_OR); }
;
xor_exp : relation XOR relation
- { ada_wrap2<ada_bitwise_xor_operation> (); }
+ { ada_wrap2<ada_bitwise_xor_operation>
+ (BINOP_BITWISE_XOR); }
| xor_exp XOR relation
- { ada_wrap2<ada_bitwise_xor_operation> (); }
+ { ada_wrap2<ada_bitwise_xor_operation>
+ (BINOP_BITWISE_XOR); }
;
/* Primaries can denote types (OP_TYPE). In cases such as
@@ -737,9 +822,9 @@ primary : primary TICK_ACCESS
| primary TICK_TAG
{ ada_wrap<ada_atr_tag_operation> (); }
| opt_type_prefix TICK_MIN '(' exp ',' exp ')'
- { ada_wrap2<ada_binop_min_operation> (); }
+ { ada_wrap2<ada_binop_min_operation> (BINOP_MIN); }
| opt_type_prefix TICK_MAX '(' exp ',' exp ')'
- { ada_wrap2<ada_binop_max_operation> (); }
+ { ada_wrap2<ada_binop_max_operation> (BINOP_MAX); }
| opt_type_prefix TICK_POS '(' exp ')'
{ ada_wrap<ada_pos_operation> (); }
| type_prefix TICK_VAL '(' exp ')'
@@ -970,7 +1055,7 @@ primary : '*' primary %prec '.'
{ ada_addrof (); }
| primary '[' exp ']'
{
- ada_wrap2<subscript_operation> ();
+ ada_wrap2<subscript_operation> (BINOP_SUBSCRIPT);
ada_wrap<ada_wrapped_operation> ();
}
;
diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index 38f4ec0452b..f63891b2955 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -3690,6 +3690,7 @@ numeric_type_p (struct type *type)
{
case TYPE_CODE_INT:
case TYPE_CODE_FLT:
+ case TYPE_CODE_FIXED_POINT:
return 1;
case TYPE_CODE_RANGE:
return (type == TYPE_TARGET_TYPE (type)
@@ -3737,6 +3738,7 @@ scalar_type_p (struct type *type)
case TYPE_CODE_RANGE:
case TYPE_CODE_ENUM:
case TYPE_CODE_FLT:
+ case TYPE_CODE_FIXED_POINT:
return 1;
default:
return 0;
diff --git a/gdb/testsuite/gdb.ada/operator_call.exp b/gdb/testsuite/gdb.ada/operator_call.exp
new file mode 100644
index 00000000000..4a35c5c6000
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/operator_call.exp
@@ -0,0 +1,115 @@
+# Copyright 2021 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"
+
+if { [skip_ada_tests] } { return -1 }
+
+standard_ada_testfile opcall
+
+if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug}] != ""} {
+ return -1
+}
+
+clean_restart ${testfile}
+
+set bp_location [gdb_get_line_number "STOP" ${testdir}/opcall.adb]
+runto "opcall.adb:$bp_location"
+
+gdb_test "print p" " = \\(x => 4, y => 5\\)"
+
+proc test_with_menu {command result} {
+ global expect_out
+
+ set rxcmd [string_to_regexp $command]
+
+ set num {}
+ send_gdb "$command\n"
+ gdb_expect 30 {
+ -re "^$rxcmd\r\n" {
+ exp_continue
+ }
+ -re "Multiple matches for \[^\r\n\]*\r\n" {
+ exp_continue
+ }
+ -re "^\\\[(\[0-9\]+)\\\] twovecs\\.*\[^\r\n\]*\r\n" {
+ set num $expect_out(1,string)
+ exp_continue
+ }
+ -re "^\\\[\[0-9\]+\\\] \[^\r\n\]*\r\n" {
+ # Any other match, we don't want.
+ exp_continue
+ }
+ -re "^> " {
+ if {$num == ""} {
+ fail $command
+ set num 0
+ }
+ send_gdb "$num\n"
+ exp_continue
+ }
+ -re "^\[0-9\]+\r\n" {
+ # The number we just sent, ignore.
+ exp_continue
+ }
+ -re "\\\$\[0-9\]+ = (\[^\r\n\]+)\r\n" {
+ if {[regexp $result $expect_out(1,string)]} {
+ pass $command
+ } else {
+ fail $command
+ }
+ }
+ timeout {
+ fail "$command (timeout)"
+ }
+ }
+}
+
+test_with_menu "print p + p" "\\(x => 8, y => 10\\)"
+test_with_menu "print p - p" "\\(x => 0, y => 0\\)"
+test_with_menu "print p * p" "\\(x => 16, y => 25\\)"
+test_with_menu "print p / p" "\\(x => 1, y => 1\\)"
+
+# See the code to understand the weird numbers here.
+test_with_menu "print p mod p" "\\(x => 17, y => 18\\)"
+test_with_menu "print p rem p" "\\(x => 38, y => 39\\)"
+test_with_menu "print p ** p" "\\(x => 84, y => 105\\)"
+
+test_with_menu "print p < p" "false"
+test_with_menu "print p < p2" "true"
+test_with_menu "print p <= p" "true"
+test_with_menu "print p <= p2" "true"
+test_with_menu "print p > p" "false"
+test_with_menu "print p2 > p" "true"
+test_with_menu "print p >= p" "true"
+test_with_menu "print p2 >= p" "true"
+test_with_menu "print p = p" "true"
+test_with_menu "print p = p2" "false"
+test_with_menu "print p /= p" "false"
+test_with_menu "print p /= p2" "true"
+
+test_with_menu "print p and p2" "\\(x => 4, y => 4\\)"
+test_with_menu "print p or p2" "\\(x => 12, y => 13\\)"
+test_with_menu "print p xor p2" "\\(x => 8, y => 9\\)"
+
+# See the code to understand the weird numbers here.
+test_with_menu "print p & p" "\\(x => 44, y => 55\\)"
+
+test_with_menu "print -p" "\\(x => 65532, y => 65531\\)"
+test_with_menu "print abs(-p)" "\\(x => 65532, y => 65531\\)"
+test_with_menu "print not(p)" "\\(x => 65531, y => 65530\\)"
+
+# See the code to understand the weird numbers here.
+test_with_menu "print +(p)" "\\(x => 5, y => 4\\)"
diff --git a/gdb/testsuite/gdb.ada/operator_call/opcall.adb b/gdb/testsuite/gdb.ada/operator_call/opcall.adb
new file mode 100644
index 00000000000..3b0de905fc7
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/operator_call/opcall.adb
@@ -0,0 +1,25 @@
+-- Copyright 2021 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 Twovecs; use Twovecs;
+
+procedure Opcall is
+ P : Twovec;
+ P2 : Twovec;
+begin
+ P := Pt (4, 5);
+ P2 := Pt (12, 12);
+ Do_Nothing (P); -- STOP
+end Opcall;
diff --git a/gdb/testsuite/gdb.ada/operator_call/twovecs.adb b/gdb/testsuite/gdb.ada/operator_call/twovecs.adb
new file mode 100644
index 00000000000..477e1934dc5
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/operator_call/twovecs.adb
@@ -0,0 +1,133 @@
+-- Copyright 2021 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 Twovecs is
+
+ function Pt (X, Y : My_Integer) return Twovec is
+ begin
+ return Twovec'(X, Y);
+ end Pt;
+
+ function "+" (P0, P1 : Twovec) return Twovec is
+ begin
+ return Twovec' (P0.X + P1.X, P0.Y + P1.Y);
+ end "+";
+
+ function "-" (P0, P1 : Twovec) return Twovec is
+ begin
+ return Twovec' (P0.X - P1.X, P0.Y - P1.Y);
+ end "-";
+
+ function "*" (P0, P1 : Twovec) return Twovec is
+ begin
+ return Twovec' (P0.X * P1.X, P0.Y * P1.Y);
+ end "*";
+
+ function "/" (P0, P1 : Twovec) return Twovec is
+ begin
+ return Twovec' (P0.X / P1.X, P0.Y / P1.Y);
+ end "/";
+
+ function "mod" (P0, P1 : Twovec) return Twovec is
+ begin
+ -- Make sure we get a different answer than "-".
+ return Twovec' (17, 18);
+ end "mod";
+
+ function "rem" (P0, P1 : Twovec) return Twovec is
+ begin
+ -- Make sure we get a different answer than "-".
+ return Twovec' (38, 39);
+ end "rem";
+
+ function "**" (P0, P1 : Twovec) return Twovec is
+ begin
+ -- It just has to do something recognizable.
+ return Twovec' (20 * P0.X + P1.X, 20 * P0.Y + P1.Y);
+ end "**";
+
+ function "<" (P0, P1 : Twovec) return Boolean is
+ begin
+ return P0.X < P1.X and then P0.Y < P1.Y;
+ end "<";
+
+ function "<=" (P0, P1 : Twovec) return Boolean is
+ begin
+ return P0.X <= P1.X and then P0.Y <= P1.Y;
+ end "<=";
+
+ function ">" (P0, P1 : Twovec) return Boolean is
+ begin
+ return P0.X > P1.X and then P0.Y > P1.Y;
+ end ">";
+
+ function ">=" (P0, P1 : Twovec) return Boolean is
+ begin
+ return P0.X >= P1.X and then P0.Y >= P1.Y;
+ end ">=";
+
+ function "=" (P0, P1 : Twovec) return Boolean is
+ begin
+ return P0.X = P1.X and then P0.Y = P1.Y;
+ end "=";
+
+ function "and" (P0, P1 : Twovec) return Twovec is
+ begin
+ return Twovec' (P0.X and P1.X, P0.Y and P1.Y);
+ end "and";
+
+ function "or" (P0, P1 : Twovec) return Twovec is
+ begin
+ return Twovec' (P0.X or P1.X, P0.Y or P1.Y);
+ end "or";
+
+ function "xor" (P0, P1 : Twovec) return Twovec is
+ begin
+ return Twovec' (P0.X xor P1.X, P0.Y xor P1.Y);
+ end "xor";
+
+ function "&" (P0, P1 : Twovec) return Twovec is
+ begin
+ -- It just has to do something recognizable.
+ return Twovec' (10 * P0.X + P1.X, 10 * P0.Y + P1.Y);
+ end "&";
+
+ function "abs" (P0 : Twovec) return Twovec is
+ begin
+ return Twovec' (abs (P0.X), abs (P0.Y));
+ end "abs";
+
+ function "not" (P0 : Twovec) return Twovec is
+ begin
+ return Twovec' (not (P0.X), not (P0.Y));
+ end "not";
+
+ function "+" (P0 : Twovec) return Twovec is
+ begin
+ -- It just has to do something recognizable.
+ return Twovec' (+ (P0.Y), + (P0.X));
+ end "+";
+
+ function "-" (P0 : Twovec) return Twovec is
+ begin
+ return Twovec' (- (P0.X), - (P0.Y));
+ end "-";
+
+ procedure Do_Nothing (P : Twovec) is
+ begin
+ null;
+ end Do_Nothing;
+
+end Twovecs;
diff --git a/gdb/testsuite/gdb.ada/operator_call/twovecs.ads b/gdb/testsuite/gdb.ada/operator_call/twovecs.ads
new file mode 100644
index 00000000000..098261c012c
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/operator_call/twovecs.ads
@@ -0,0 +1,55 @@
+-- Copyright 2021 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 Twovecs is
+ type My_Integer is mod 2**16 ;
+
+ type Twovec is private;
+
+ function Pt (X, Y : My_Integer) return Twovec;
+
+ function "+" (P0, P1 : Twovec) return Twovec;
+ function "-" (P0, P1 : Twovec) return Twovec;
+ function "*" (P0, P1 : Twovec) return Twovec;
+ function "/" (P0, P1 : Twovec) return Twovec;
+ function "mod" (P0, P1 : Twovec) return Twovec;
+ function "rem" (P0, P1 : Twovec) return Twovec;
+ function "**" (P0, P1 : Twovec) return Twovec;
+
+ function "<" (P0, P1 : Twovec) return Boolean;
+ function "<=" (P0, P1 : Twovec) return Boolean;
+ function ">" (P0, P1 : Twovec) return Boolean;
+ function ">=" (P0, P1 : Twovec) return Boolean;
+ function "=" (P0, P1 : Twovec) return Boolean;
+
+ function "and" (P0, P1 : Twovec) return Twovec;
+ function "or" (P0, P1 : Twovec) return Twovec;
+ function "xor" (P0, P1 : Twovec) return Twovec;
+ function "&" (P0, P1 : Twovec) return Twovec;
+
+ function "abs" (P0 : Twovec) return Twovec;
+ function "not" (P0 : Twovec) return Twovec;
+ function "+" (P0 : Twovec) return Twovec;
+ function "-" (P0 : Twovec) return Twovec;
+
+ procedure Do_Nothing (P : Twovec);
+
+private
+
+ type Twovec is record
+ X, Y : My_Integer;
+ end record;
+
+end Twovecs;
--
2.26.2
^ permalink raw reply [flat|nested] 7+ messages in thread