diff options
| -rw-r--r-- | gdb/f-exp.y | 57 | ||||
| -rw-r--r-- | gdb/testsuite/gdb.fortran/intrinsic-precedence.c | 18 | ||||
| -rw-r--r-- | gdb/testsuite/gdb.fortran/intrinsic-precedence.exp | 74 | ||||
| -rw-r--r-- | gdb/testsuite/gdb.fortran/intrinsic-precedence.f90 | 33 |
4 files changed, 163 insertions, 19 deletions
diff --git a/gdb/f-exp.y b/gdb/f-exp.y index c0afebc..19e4c70 100644 --- a/gdb/f-exp.y +++ b/gdb/f-exp.y @@ -1278,6 +1278,28 @@ static const struct f77_boolean_val boolean_values[] = { ".false.", 0 } }; +static const struct token f_intrinsics[] = +{ + /* The following correspond to actual functions in Fortran and are case + insensitive. */ + { "kind", KIND, OP_NULL, false }, + { "abs", UNOP_INTRINSIC, UNOP_ABS, false }, + { "mod", BINOP_INTRINSIC, BINOP_MOD, false }, + { "floor", UNOP_OR_BINOP_INTRINSIC, FORTRAN_FLOOR, false }, + { "ceiling", UNOP_OR_BINOP_INTRINSIC, FORTRAN_CEILING, false }, + { "modulo", BINOP_INTRINSIC, BINOP_FORTRAN_MODULO, false }, + { "cmplx", UNOP_OR_BINOP_OR_TERNOP_INTRINSIC, FORTRAN_CMPLX, false }, + { "lbound", UNOP_OR_BINOP_OR_TERNOP_INTRINSIC, FORTRAN_LBOUND, false }, + { "ubound", UNOP_OR_BINOP_OR_TERNOP_INTRINSIC, FORTRAN_UBOUND, false }, + { "allocated", UNOP_INTRINSIC, UNOP_FORTRAN_ALLOCATED, false }, + { "associated", UNOP_OR_BINOP_INTRINSIC, FORTRAN_ASSOCIATED, false }, + { "rank", UNOP_INTRINSIC, UNOP_FORTRAN_RANK, false }, + { "size", UNOP_OR_BINOP_OR_TERNOP_INTRINSIC, FORTRAN_ARRAY_SIZE, false }, + { "shape", UNOP_INTRINSIC, UNOP_FORTRAN_SHAPE, false }, + { "loc", UNOP_INTRINSIC, UNOP_FORTRAN_LOC, false }, + { "sizeof", SIZEOF, OP_NULL, false }, +}; + static const token f_keywords[] = { /* Historically these have always been lowercase only in GDB. */ @@ -1300,27 +1322,9 @@ static const token f_keywords[] = { "real_4", REAL_S4_KEYWORD, OP_NULL, true }, { "real_8", REAL_S8_KEYWORD, OP_NULL, true }, { "real_16", REAL_S16_KEYWORD, OP_NULL, true }, - { "sizeof", SIZEOF, OP_NULL, true }, { "single", SINGLE, OP_NULL, true }, { "double", DOUBLE, OP_NULL, true }, { "precision", PRECISION, OP_NULL, true }, - /* The following correspond to actual functions in Fortran and are case - insensitive. */ - { "kind", KIND, OP_NULL, false }, - { "abs", UNOP_INTRINSIC, UNOP_ABS, false }, - { "mod", BINOP_INTRINSIC, BINOP_MOD, false }, - { "floor", UNOP_OR_BINOP_INTRINSIC, FORTRAN_FLOOR, false }, - { "ceiling", UNOP_OR_BINOP_INTRINSIC, FORTRAN_CEILING, false }, - { "modulo", BINOP_INTRINSIC, BINOP_FORTRAN_MODULO, false }, - { "cmplx", UNOP_OR_BINOP_OR_TERNOP_INTRINSIC, FORTRAN_CMPLX, false }, - { "lbound", UNOP_OR_BINOP_OR_TERNOP_INTRINSIC, FORTRAN_LBOUND, false }, - { "ubound", UNOP_OR_BINOP_OR_TERNOP_INTRINSIC, FORTRAN_UBOUND, false }, - { "allocated", UNOP_INTRINSIC, UNOP_FORTRAN_ALLOCATED, false }, - { "associated", UNOP_OR_BINOP_INTRINSIC, FORTRAN_ASSOCIATED, false }, - { "rank", UNOP_INTRINSIC, UNOP_FORTRAN_RANK, false }, - { "size", UNOP_OR_BINOP_OR_TERNOP_INTRINSIC, FORTRAN_ARRAY_SIZE, false }, - { "shape", UNOP_INTRINSIC, UNOP_FORTRAN_SHAPE, false }, - { "loc", UNOP_INTRINSIC, UNOP_FORTRAN_LOC, false }, }; /* Implementation of a dynamically expandable buffer for processing input @@ -1663,7 +1667,22 @@ yylex (void) pstate->gdbarch (), tmp.c_str ()); if (yylval.tsym.type != NULL) return TYPENAME; - + + /* This is post the symbol search as symbols can hide intrinsics. Also, + give Fortran intrinsics priority over C symbols. This prevents + non-Fortran symbols from hiding intrinsics, for example abs. */ + if (!result.symbol || result.symbol->language () != language_fortran) + for (const auto &intrinsic : f_intrinsics) + { + gdb_assert (!intrinsic.case_sensitive); + if (strlen (intrinsic.oper) == namelen + && strncasecmp (tokstart, intrinsic.oper, namelen) == 0) + { + yylval.opcode = intrinsic.opcode; + return intrinsic.token; + } + } + /* Input names that aren't symbols but ARE valid hex numbers, when the input radix permits them, can be names or numbers depending on the parse. Note we support radixes > 16 here. */ diff --git a/gdb/testsuite/gdb.fortran/intrinsic-precedence.c b/gdb/testsuite/gdb.fortran/intrinsic-precedence.c new file mode 100644 index 0000000..cec960c --- /dev/null +++ b/gdb/testsuite/gdb.fortran/intrinsic-precedence.c @@ -0,0 +1,18 @@ +/* Copyright 2023 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/>. */ + +int kind (int a) { + return 7; +} diff --git a/gdb/testsuite/gdb.fortran/intrinsic-precedence.exp b/gdb/testsuite/gdb.fortran/intrinsic-precedence.exp new file mode 100644 index 0000000..3269033 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/intrinsic-precedence.exp @@ -0,0 +1,74 @@ +# Copyright 2023 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/>. + +require allow_fortran_tests +require allow_shlib_tests + +standard_testfile .f90 +load_lib fortran.exp + +set srcfile_lib ${srcdir}/${subdir}/${testfile}.c +set binfile_lib [standard_output_file ${testfile}.so] +set lib_flags [list debug] +set bin_flags [list f90 debug shlib=${binfile_lib}] + +if {[gdb_compile_shlib ${srcfile_lib} ${binfile_lib} $lib_flags] != "" } { + return -1 +} + +if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + ${bin_flags}]} { + return -1 +} + +if ![fortran_runto_main] { + return -1 +} + +gdb_breakpoint [gdb_get_line_number "all-assigned"] +gdb_continue_to_breakpoint "all-assigned" + +# Variable in source is upper case. +gdb_test "print LOC" "17" +gdb_test "print loc" "17" + +# Variable in source is lower case +gdb_test "print UBOUND" "79" +gdb_test "print ubound" "79" + +# Intrinsic hides a C symbol that has debug information. This mimics the abs +# scenario, where it can exist as a function in C, a Fortran intrinsic and a +# user defined variable/function. +gdb_test "print kind(minus)" "4" +# Confirm that the C symbol is there to be chosen if the precedence order is +# incorrect. +gdb_test "set lang c" \ + "Warning: the current language does not match this frame." +gdb_test "print kind(3)" "7" +gdb_test_no_output "set lang fortran" + +# User defined abs function hides the intrinsic. +gdb_breakpoint [gdb_get_line_number "user-abs"] +gdb_continue_to_breakpoint "user-abs" +set integer4 [fortran_int4] +gdb_test "whatis abs" "void \\\(${integer4}(, uinteger\\\*8)?\\\)" + +# Test the scenario where the C defined version of kind is not returned by +# lookup_symbol. +gdb_test_no_output "set confirm off" +# breakpoints cannot be reset without symbol information. +gdb_test_no_output "delete" +gdb_test "symbol-file" "No symbol file now." +gdb_test "print kind(0)" "4" diff --git a/gdb/testsuite/gdb.fortran/intrinsic-precedence.f90 b/gdb/testsuite/gdb.fortran/intrinsic-precedence.f90 new file mode 100644 index 0000000..7b7c3b2 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/intrinsic-precedence.f90 @@ -0,0 +1,33 @@ +! Copyright 2023 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 2 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, write to the Free Software +! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +program intrinsic_precedence + implicit none + integer(kind=4) LOC, ubound, minus + LOC = 17 + ubound = 79 + minus = -1 + print *, minus, LOC, ubound + call abs(minus) !all-assigned +contains + subroutine abs(i) + integer(kind=4) :: i + if(i .lt. 0) then + i = -i + endif + print *, i !user-abs + end subroutine abs +end program intrinsic_precedence |