@@ -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 e.g. abs. */
+ if (!result.symbol || result.symbol->language () != language_fortran)
+ for (int i = 0; i < ARRAY_SIZE (f_intrinsics); i++)
+ {
+ gdb_assert (!f_intrinsics[i].case_sensitive);
+ if (strlen (f_intrinsics[i].oper) == namelen
+ && strncasecmp (tokstart, f_intrinsics[i].oper, namelen) == 0)
+ {
+ yylval.opcode = f_intrinsics[i].opcode;
+ return f_intrinsics[i].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. */
new file mode 100644
@@ -0,0 +1,44 @@
+# 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/>.
+
+standard_testfile .f90
+load_lib fortran.exp
+
+require allow_fortran_tests
+
+if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90}]} {
+ return -1
+}
+
+if { ![fortran_runto_main] } {
+ perror "Could not run to main."
+ return
+}
+
+gdb_breakpoint [gdb_get_line_number "all-assigned"]
+
+gdb_continue_to_breakpoint "all-assigned"
+
+foreach_with_prefix case {"LOC" "loc"} {
+ gdb_test "print $case" "17" \
+ "user defined uppercase LOC hides the intrinsic"
+}
+
+gdb_test "print UBOUND" "79" \
+ "user defined lowercase ubound hides the intrinsic"
+
+gdb_test "print ABS" "20" \
+ "user defined ABS hides the intrinsic and any non-fortran symbol"
new file mode 100644
@@ -0,0 +1,24 @@
+! 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 LOC, ABS, ubound
+ LOC = 17
+ ABS = 20
+ ubound = 79
+ print *, LOC, ABS, ubound !all-assigned
+end program intrinsic_precedence