Fortran specific: Add logical XOR ops for compiler compliance
Commit Message
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
Comments
* Tomasz Kulasek <tomek.kulasek@gmail.com> [2019-09-26 05:07:04 +0200]:
> 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.
Thanks for doing this. I have a few comments inline below.
I don't know what the situation is as far as copyright assignment
here. Christoph does have a previous commit in GDB so I guess he has
copyright assignment in place, and I guess as you're attributing this
work to him, then maybe it doesn't matter if you have an assignment or
not? Someone who understands copyright stuff better than me should
just OK this before it is merged.
>
> 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))));
A couple of these lines are getting on the long side, it might be nice
to see if you could wrap them.
> + }
> }
>
> 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
It wasn't clear why PREC_LOGICAL_XOR was placed at the end of this
list, and not next to PREC_LOGICAL_OR.
> };
>
> /* 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) /* ^^ */
I think you need to handle this new BINOP_LOGICAL_XOR in
expprint.c:dump_subexp_body_standard and
breakpoint.c:watchpoint_exp_is_const too.
> 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>
New files shouldn't have "Contributed by" lines, see:
https://sourceware.org/gdb/wiki/ContributionChecklist#Attribution
> +
> +# 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"
Some of these lines are definitely too long, and also you have
duplicate test names. Each test name should be unique within a test
script - it makes tracking down failures easier. In this case if you
just drop the third argument to gdb_test you'll end up using the
command as the test name, plus shorter lines!
> 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>
"Contributed by..." again.
> +!
> +! 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
>
@@ -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:
@@ -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
@@ -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}
};
@@ -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
@@ -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) /* ^ */
new file mode 100644
@@ -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"
new file mode 100644
@@ -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