Implement Ada operator overloading
authorTom Tromey <tromey@adacore.com>
Mon, 15 Mar 2021 12:23:12 +0000 (06:23 -0600)
committerTom Tromey <tromey@adacore.com>
Mon, 15 Mar 2021 12:23:13 +0000 (06:23 -0600)
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-15  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-15  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
gdb/ada-exp.y
gdb/ada-lang.c
gdb/testsuite/ChangeLog
gdb/testsuite/gdb.ada/operator_call.exp [new file with mode: 0644]
gdb/testsuite/gdb.ada/operator_call/opcall.adb [new file with mode: 0644]
gdb/testsuite/gdb.ada/operator_call/twovecs.adb [new file with mode: 0644]
gdb/testsuite/gdb.ada/operator_call/twovecs.ads [new file with mode: 0644]

index 3033d11387dc6b63f1426ac980ff734fd6e57c74..a5580fde4d6e63d5067a7fd799b4a05ec639ac15 100644 (file)
@@ -1,3 +1,13 @@
+2021-03-15  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.
+
 2021-03-15  Tom Tromey  <tromey@adacore.com>
 
        PR ada/27545:
index 4300907685c91f970818a581892e710590ae5d92..e8ffb8e1040b430ff6c6acb3d29a264437ccf493 100644 (file)
@@ -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> ();
                        }
        ;
index 07958e7934e153634f56304c563cd48ad7f62fc6..a74f5408484677d00c0ff7b645483aa58e75f1ed 100644 (file)
@@ -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;
index 7df84af72fcbb2d6ee23d582a2f9c6398ba39767..728405e960687cf56d74f0c04932c973411b3c90 100644 (file)
@@ -1,3 +1,10 @@
+2021-03-15  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.
+
 2021-03-15  Tom Tromey  <tromey@adacore.com>
 
        * gdb.ada/enums_overload/enums_overload_main.adb: New file.
diff --git a/gdb/testsuite/gdb.ada/operator_call.exp b/gdb/testsuite/gdb.ada/operator_call.exp
new file mode 100644 (file)
index 0000000..4a35c5c
--- /dev/null
@@ -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 (file)
index 0000000..3b0de90
--- /dev/null
@@ -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 (file)
index 0000000..477e193
--- /dev/null
@@ -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 (file)
index 0000000..098261c
--- /dev/null
@@ -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;