Implement Ada operator overloading
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.
This commit is contained in:
Tom Tromey
parent
9863c3b5fc
commit
c04da66c26
8 changed files with 467 additions and 35 deletions
|
|
@ -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:
|
||||
|
|
|
|||
155
gdb/ada-exp.y
155
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> ();
|
||||
}
|
||||
;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
115
gdb/testsuite/gdb.ada/operator_call.exp
Normal file
115
gdb/testsuite/gdb.ada/operator_call.exp
Normal file
|
|
@ -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\\)"
|
||||
25
gdb/testsuite/gdb.ada/operator_call/opcall.adb
Normal file
25
gdb/testsuite/gdb.ada/operator_call/opcall.adb
Normal file
|
|
@ -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;
|
||||
133
gdb/testsuite/gdb.ada/operator_call/twovecs.adb
Normal file
133
gdb/testsuite/gdb.ada/operator_call/twovecs.adb
Normal file
|
|
@ -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;
|
||||
55
gdb/testsuite/gdb.ada/operator_call/twovecs.ads
Normal file
55
gdb/testsuite/gdb.ada/operator_call/twovecs.ads
Normal file
|
|
@ -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;
|
||||
Loading…
Add table
Add a link
Reference in a new issue