+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:
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
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
{
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
/* 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 ();
;
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; }
/* 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
;
simple_exp : simple_exp '&' simple_exp
- { ada_wrap2<concat_operation> (); }
+ { ada_wrap2<concat_operation> (BINOP_CONCAT); }
;
simple_exp : simple_exp '-' 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
;
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
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
| 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 ')'
{ ada_addrof (); }
| primary '[' exp ']'
{
- ada_wrap2<subscript_operation> ();
+ ada_wrap2<subscript_operation> (BINOP_SUBSCRIPT);
ada_wrap<ada_wrapped_operation> ();
}
;
{
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)
case TYPE_CODE_RANGE:
case TYPE_CODE_ENUM:
case TYPE_CODE_FLT:
+ case TYPE_CODE_FIXED_POINT:
return 1;
default:
return 0;
+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.
--- /dev/null
+# 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\\)"
--- /dev/null
+-- 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;
--- /dev/null
+-- 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;
--- /dev/null
+-- 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;
projects / deliverable / binutils-gdb.git / commitdiff
