This is the mail archive of the
gdb-patches@sourceware.org
mailing list for the GDB project.
[PATCH] Fortran specific: Add logical XOR ops for compiler compliance
- From: Tomasz Kulasek <tomek dot kulasek at gmail dot com>
- To: gdb-patches at sourceware dot org
- Cc: Christoph Weinmann <christoph dot t dot weinmann at intel dot com>, Felix Willgerodt <felix dot willgerodt at intel dot com>
- Date: Thu, 26 Sep 2019 05:07:04 +0200
- Subject: [PATCH] Fortran specific: Add logical XOR ops for compiler compliance
From: Christoph Weinmann <christoph.t.weinmann@intel.com>
Add Fortran specific XOR ops for logical types to GDB, to provide
the same functionality as GFORT.
2013-10-01 Christoph Weinmann <christoph.t.weinmann@intel.com>
gdb/
* eval.c (evaluate_subexp_standard): Add case for
BINOP_LOGICAL_XOR.
* f-exp.y : Add rule for BINOP_LOGICAL_XOR, extend struct
f77_keywords.
* f-lang.c (f_op_print_tab): Add XOR opcode to print
precedence struct.
* parser-defs.h (precedence): Add XOR opcode to precedence
struct.
* std-operator.def : Add XOR opcode to opcode list.
gdb/testsuite/
* logical_xor.f90 : Fortran program for logical OR and XOR
printing.
* logical_xor.exp : Test for printing Fortran logical OR
and XOR operations.
Signed-off-by: Felix Willgerodt <felix.willgerodt@intel.com>
---
gdb/eval.c | 19 +++++++++---
gdb/f-exp.y | 8 ++++-
gdb/f-lang.c | 1 +
gdb/parser-defs.h | 3 +-
gdb/std-operator.def | 1 +
gdb/testsuite/gdb.fortran/logical_xor.exp | 37 +++++++++++++++++++++++
gdb/testsuite/gdb.fortran/logical_xor.f90 | 29 ++++++++++++++++++
7 files changed, 92 insertions(+), 6 deletions(-)
create mode 100644 gdb/testsuite/gdb.fortran/logical_xor.exp
create mode 100644 gdb/testsuite/gdb.fortran/logical_xor.f90
diff --git a/gdb/eval.c b/gdb/eval.c
index 70ba1f1e3f..8c0de581d0 100644
--- a/gdb/eval.c
+++ b/gdb/eval.c
@@ -2452,6 +2452,7 @@ evaluate_subexp_standard (struct type *expect_type,
}
case BINOP_LOGICAL_OR:
+ case BINOP_LOGICAL_XOR:
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
if (noside == EVAL_SKIP)
{
@@ -2471,11 +2472,21 @@ evaluate_subexp_standard (struct type *expect_type,
else
{
tem = value_logical_not (arg1);
- arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
- (!tem ? EVAL_SKIP : noside));
type = language_bool_type (exp->language_defn, exp->gdbarch);
- return value_from_longest (type,
- (LONGEST) (!tem || !value_logical_not (arg2)));
+
+ if(op == BINOP_LOGICAL_OR)
+ {
+ arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
+ (!tem ? EVAL_SKIP : noside));
+ return value_from_longest (type,
+ (LONGEST) (!tem || !value_logical_not (arg2)));
+ }
+ else
+ {
+ return value_from_longest (type,
+ (LONGEST) ((tem && !value_logical_not (arg2))
+ || (!tem && value_logical_not (arg2))));
+ }
}
case BINOP_EQUAL:
diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index 9784ad57d8..9d0ff6b39b 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -168,7 +168,7 @@ static int parse_number (struct parser_state *, const char *, int,
%token LOGICAL_S8_KEYWORD
%token LOGICAL_KEYWORD REAL_KEYWORD REAL_S8_KEYWORD REAL_S16_KEYWORD
%token COMPLEX_S8_KEYWORD COMPLEX_S16_KEYWORD COMPLEX_S32_KEYWORD
-%token BOOL_AND BOOL_OR BOOL_NOT
+%token BOOL_AND BOOL_OR BOOL_NOT BOOL_XOR
%token <lval> CHARACTER
%token <voidval> DOLLAR_VARIABLE
@@ -183,6 +183,7 @@ static int parse_number (struct parser_state *, const char *, int,
%left BOOL_OR
%right BOOL_NOT
%left BOOL_AND
+%left BOOL_XOR
%left '|'
%left '^'
%left '&'
@@ -411,6 +412,10 @@ exp : exp BOOL_OR exp
{ write_exp_elt_opcode (pstate, BINOP_LOGICAL_OR); }
;
+exp : exp BOOL_XOR exp
+ { write_exp_elt_opcode (pstate, BINOP_LOGICAL_XOR); }
+ ;
+
exp : exp '=' exp
{ write_exp_elt_opcode (pstate, BINOP_ASSIGN); }
;
@@ -922,6 +927,7 @@ static const struct token dot_ops[] =
{ ".ge.", GEQ, BINOP_END, false },
{ ".gt.", GREATERTHAN, BINOP_END, false },
{ ".lt.", LESSTHAN, BINOP_END, false },
+ { ".xor.", BOOL_XOR, BINOP_END, false },
};
/* Holds the Fortran representation of a boolean, and the integer value we
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index ce7f1471c5..ef51a3f228 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -145,6 +145,7 @@ static const struct op_print f_op_print_tab[] =
{".LT.", BINOP_LESS, PREC_ORDER, 0},
{"**", UNOP_IND, PREC_PREFIX, 0},
{"@", BINOP_REPEAT, PREC_REPEAT, 0},
+ {".XOR.", BINOP_LOGICAL_XOR, PREC_LOGICAL_XOR, 0},
{NULL, OP_NULL, PREC_REPEAT, 0}
};
diff --git a/gdb/parser-defs.h b/gdb/parser-defs.h
index 64aa9b8b1e..5e4feda830 100644
--- a/gdb/parser-defs.h
+++ b/gdb/parser-defs.h
@@ -370,7 +370,8 @@ enum precedence
PREC_NULL, PREC_COMMA, PREC_ABOVE_COMMA, PREC_ASSIGN, PREC_LOGICAL_OR,
PREC_LOGICAL_AND, PREC_BITWISE_IOR, PREC_BITWISE_AND, PREC_BITWISE_XOR,
PREC_EQUAL, PREC_ORDER, PREC_SHIFT, PREC_ADD, PREC_MUL, PREC_REPEAT,
- PREC_HYPER, PREC_PREFIX, PREC_SUFFIX, PREC_BUILTIN_FUNCTION
+ PREC_HYPER, PREC_PREFIX, PREC_SUFFIX, PREC_BUILTIN_FUNCTION,
+ PREC_LOGICAL_XOR
};
/* Table mapping opcodes into strings for printing operators
diff --git a/gdb/std-operator.def b/gdb/std-operator.def
index a5247ab940..c80bb62f91 100644
--- a/gdb/std-operator.def
+++ b/gdb/std-operator.def
@@ -34,6 +34,7 @@ OP (BINOP_LSH) /* << */
OP (BINOP_RSH) /* >> */
OP (BINOP_LOGICAL_AND) /* && */
OP (BINOP_LOGICAL_OR) /* || */
+OP (BINOP_LOGICAL_XOR) /* ^^ */
OP (BINOP_BITWISE_AND) /* & */
OP (BINOP_BITWISE_IOR) /* | */
OP (BINOP_BITWISE_XOR) /* ^ */
diff --git a/gdb/testsuite/gdb.fortran/logical_xor.exp b/gdb/testsuite/gdb.fortran/logical_xor.exp
new file mode 100644
index 0000000000..e4fbfc6bb4
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/logical_xor.exp
@@ -0,0 +1,37 @@
+# Copyright 2019 Free Software Foundation, Inc.
+
+# Contributed by Intel Corp. <christoph.t.weinmann@intel.com>
+
+# 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/>.
+
+standard_testfile .f90
+
+if { [prepare_for_testing $testfile.exp $testfile $srcfile {debug f90}] } {
+ return -1
+}
+
+if ![runto MAIN__] then {
+ perror "couldn't run to breakpoint MAIN__"
+ continue
+}
+
+gdb_breakpoint [gdb_get_line_number "stop_here"]
+gdb_continue_to_breakpoint "stop_here"
+
+gdb_test "print val_a" "\\$\[0-9\]+ = \.TRUE\." "print val_a value TRUE"
+gdb_test "print val_b" "\\$\[0-9\]+ = \.FALSE\." "print val_b value FALSE"
+gdb_test "print val_a \.or\. val_b" "\\$\[0-9\]+ = \.TRUE\." "print val_a value TRUE"
+gdb_test "print val_a \.xor\. val_b" "\\$\[0-9\]+ = \.TRUE\." "print val_a value TRUE"
+gdb_test "print val_a \.xor\. \.true\." "\\$\[0-9\]+ = \.FALSE\." "print val_a value FALSE"
+gdb_test "print val_b \.xor\. \.false\." "\\$\[0-9\]+ = \.FALSE\." "print val_a value FALSE"
diff --git a/gdb/testsuite/gdb.fortran/logical_xor.f90 b/gdb/testsuite/gdb.fortran/logical_xor.f90
new file mode 100644
index 0000000000..665a0e6fff
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/logical_xor.f90
@@ -0,0 +1,29 @@
+! Copyright 2019 Free Software Foundation, Inc.
+!
+! Contributed by Intel Corp. <christoph.t.weinmann@intel.com>
+!
+! 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/>.
+
+subroutine sub
+ logical :: val_a = .true., val_b = .false.
+ logical val_c
+
+ val_c = xor(val_a, val_b)
+ return !stop_here
+end
+
+program prog
+ implicit none
+ call sub
+end
--
2.17.1