struct token
{
+ /* The string to match against. */
const char *oper;
+
+ /* The lexer token to return. */
int token;
+
+ /* The expression opcode to embed within the token. */
enum exp_opcode opcode;
+
+ /* When this is true the string in OPER is matched exactly including
+ case, when this is false OPER is matched case insensitively. */
+ bool case_sensitive;
};
static const struct token dot_ops[] =
{
- { ".and.", BOOL_AND, BINOP_END },
- { ".AND.", BOOL_AND, BINOP_END },
- { ".or.", BOOL_OR, BINOP_END },
- { ".OR.", BOOL_OR, BINOP_END },
- { ".not.", BOOL_NOT, BINOP_END },
- { ".NOT.", BOOL_NOT, BINOP_END },
- { ".eq.", EQUAL, BINOP_END },
- { ".EQ.", EQUAL, BINOP_END },
- { ".eqv.", EQUAL, BINOP_END },
- { ".NEQV.", NOTEQUAL, BINOP_END },
- { ".neqv.", NOTEQUAL, BINOP_END },
- { ".EQV.", EQUAL, BINOP_END },
- { ".ne.", NOTEQUAL, BINOP_END },
- { ".NE.", NOTEQUAL, BINOP_END },
- { ".le.", LEQ, BINOP_END },
- { ".LE.", LEQ, BINOP_END },
- { ".ge.", GEQ, BINOP_END },
- { ".GE.", GEQ, BINOP_END },
- { ".gt.", GREATERTHAN, BINOP_END },
- { ".GT.", GREATERTHAN, BINOP_END },
- { ".lt.", LESSTHAN, BINOP_END },
- { ".LT.", LESSTHAN, BINOP_END },
- { NULL, 0, BINOP_END }
+ { ".and.", BOOL_AND, BINOP_END, false },
+ { ".or.", BOOL_OR, BINOP_END, false },
+ { ".not.", BOOL_NOT, BINOP_END, false },
+ { ".eq.", EQUAL, BINOP_END, false },
+ { ".eqv.", EQUAL, BINOP_END, false },
+ { ".neqv.", NOTEQUAL, BINOP_END, false },
+ { ".ne.", NOTEQUAL, BINOP_END, false },
+ { ".le.", LEQ, BINOP_END, false },
+ { ".ge.", GEQ, BINOP_END, false },
+ { ".gt.", GREATERTHAN, BINOP_END, false },
+ { ".lt.", LESSTHAN, BINOP_END, false },
};
/* Holds the Fortran representation of a boolean, and the integer value we
{ ".false.", 0 }
};
-static const struct token f77_keywords[] =
+static const struct token f77_keywords[] =
{
- { "complex_16", COMPLEX_S16_KEYWORD, BINOP_END },
- { "complex_32", COMPLEX_S32_KEYWORD, BINOP_END },
- { "character", CHARACTER, BINOP_END },
- { "integer_2", INT_S2_KEYWORD, BINOP_END },
- { "logical_1", LOGICAL_S1_KEYWORD, BINOP_END },
- { "logical_2", LOGICAL_S2_KEYWORD, BINOP_END },
- { "logical_8", LOGICAL_S8_KEYWORD, BINOP_END },
- { "complex_8", COMPLEX_S8_KEYWORD, BINOP_END },
- { "integer", INT_KEYWORD, BINOP_END },
- { "logical", LOGICAL_KEYWORD, BINOP_END },
- { "real_16", REAL_S16_KEYWORD, BINOP_END },
- { "complex", COMPLEX_S8_KEYWORD, BINOP_END },
- { "sizeof", SIZEOF, BINOP_END },
- { "real_8", REAL_S8_KEYWORD, BINOP_END },
- { "real", REAL_KEYWORD, BINOP_END },
- { NULL, 0, BINOP_END }
-};
+ /* Historically these have always been lowercase only in GDB. */
+ { "complex_16", COMPLEX_S16_KEYWORD, BINOP_END, true },
+ { "complex_32", COMPLEX_S32_KEYWORD, BINOP_END, true },
+ { "character", CHARACTER, BINOP_END, true },
+ { "integer_2", INT_S2_KEYWORD, BINOP_END, true },
+ { "logical_1", LOGICAL_S1_KEYWORD, BINOP_END, true },
+ { "logical_2", LOGICAL_S2_KEYWORD, BINOP_END, true },
+ { "logical_8", LOGICAL_S8_KEYWORD, BINOP_END, true },
+ { "complex_8", COMPLEX_S8_KEYWORD, BINOP_END, true },
+ { "integer", INT_KEYWORD, BINOP_END, true },
+ { "logical", LOGICAL_KEYWORD, BINOP_END, true },
+ { "real_16", REAL_S16_KEYWORD, BINOP_END, true },
+ { "complex", COMPLEX_S8_KEYWORD, BINOP_END, true },
+ { "sizeof", SIZEOF, BINOP_END, true },
+ { "real_8", REAL_S8_KEYWORD, BINOP_END, true },
+ { "real", REAL_KEYWORD, BINOP_END, true },
+};
/* Implementation of a dynamically expandable buffer for processing input
characters acquired through lexptr and building a value to return in
}
}
}
-
+
/* See if it is a special .foo. operator. */
-
- for (int i = 0; dot_ops[i].oper != NULL; i++)
- if (strncmp (tokstart, dot_ops[i].oper,
- strlen (dot_ops[i].oper)) == 0)
+ for (int i = 0; i < ARRAY_SIZE (dot_ops); i++)
+ if (strncasecmp (tokstart, dot_ops[i].oper,
+ strlen (dot_ops[i].oper)) == 0)
{
+ gdb_assert (!dot_ops[i].case_sensitive);
lexptr += strlen (dot_ops[i].oper);
yylval.opcode = dot_ops[i].opcode;
return dot_ops[i].token;
}
-
+
/* See if it is an exponentiation operator. */
if (strncmp (tokstart, "**", 2) == 0)
lexptr += namelen;
/* Catch specific keywords. */
-
- for (int i = 0; f77_keywords[i].oper != NULL; i++)
+
+ for (int i = 0; i < ARRAY_SIZE (f77_keywords); i++)
if (strlen (f77_keywords[i].oper) == namelen
- && strncmp (tokstart, f77_keywords[i].oper, namelen) == 0)
+ && ((!f77_keywords[i].case_sensitive
+ && strncasecmp (tokstart, f77_keywords[i].oper, namelen) == 0)
+ || (f77_keywords[i].case_sensitive
+ && strncmp (tokstart, f77_keywords[i].oper, namelen) == 0)))
{
- /* lexptr += strlen(f77_keywords[i].operator); */
yylval.opcode = f77_keywords[i].opcode;
return f77_keywords[i].token;
}
-
+
yylval.sval.ptr = tokstart;
yylval.sval.length = namelen;
--- /dev/null
+# Copyright 2019 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/>.
+
+# This file tests GDB's handling of some of the builtin logical and
+# arithmetic dot operators in Fortran, for example `.AND.` and `.LE.`.
+
+load_lib "fortran.exp"
+
+if { [skip_fortran_tests] } { continue }
+
+proc test_dot_operations {} {
+
+ foreach_with_prefix format { "uppercase" "lowercase" } {
+ if {$format == "uppercase"} {
+ set true ".TRUE."
+ set false ".FALSE."
+ set and ".AND."
+ set or ".OR."
+ set not ".NOT."
+ set eqv ".EQV."
+ set neqv ".NEQV."
+ set eq ".EQ."
+ set ne ".NE."
+ set le ".LE."
+ set ge ".GE."
+ set lt ".LT."
+ set gt ".GT."
+ } else {
+ set true ".true."
+ set false ".false."
+ set and ".and."
+ set or ".or."
+ set not ".not."
+ set eqv ".eqv."
+ set neqv ".neqv."
+ set eq ".eq."
+ set ne ".ne."
+ set le ".le."
+ set ge ".ge."
+ set lt ".lt."
+ set gt ".gt."
+ }
+
+ # Logical AND
+ gdb_test "p $true $and $true" " = .TRUE."
+ gdb_test "p $true $and $false" " = .FALSE."
+ gdb_test "p $false $and $true" " = .FALSE."
+ gdb_test "p $false $and $false" " = .FALSE."
+
+ # Logical OR
+ gdb_test "p $true $or $true" " = .TRUE."
+ gdb_test "p $true $or $false" " = .TRUE."
+ gdb_test "p $false $or $true" " = .TRUE."
+ gdb_test "p $false $or $false" " = .FALSE."
+
+ # Logical NOT
+ gdb_test "p $not $true" " = .FALSE."
+ gdb_test "p $not $false" " = .TRUE."
+
+ # Logical EQV
+ gdb_test "p $true $eqv $true" " = .TRUE."
+ gdb_test "p $true $eqv $false" " = .FALSE."
+ gdb_test "p $false $eqv $true" " = .FALSE."
+ gdb_test "p $false $eqv $false" " = .TRUE."
+
+ # Logical NEQV
+ gdb_test "p $true $neqv $true" " = .FALSE."
+ gdb_test "p $true $neqv $false" " = .TRUE."
+ gdb_test "p $false $neqv $true" " = .TRUE."
+ gdb_test "p $false $neqv $false" " = .FALSE."
+
+ # Arithmetic EQ
+ gdb_test "p 5 $eq 4" " = .FALSE."
+ gdb_test "p 4 $eq 4" " = .TRUE."
+
+ # Arithmetic NE
+ gdb_test "p 5 $ne 4" " = .TRUE."
+ gdb_test "p 4 $ne 4" " = .FALSE."
+
+ # Arithmetic LE
+ gdb_test "p 5 $le 4" " = .FALSE."
+ gdb_test "p 4 $le 4" " = .TRUE."
+ gdb_test "p 3 $le 4" " = .TRUE."
+
+ # Arithmetic LT
+ gdb_test "p 5 $lt 4" " = .FALSE."
+ gdb_test "p 4 $lt 4" " = .FALSE."
+ gdb_test "p 3 $lt 4" " = .TRUE."
+
+ # Arithmetic GE
+ gdb_test "p 5 $ge 4" " = .TRUE."
+ gdb_test "p 4 $ge 4" " = .TRUE."
+ gdb_test "p 3 $ge 4" " = .FALSE."
+
+ # Arithmetic GT
+ gdb_test "p 5 $gt 4" " = .TRUE."
+ gdb_test "p 4 $gt 4" " = .FALSE."
+ gdb_test "p 3 $gt 4" " = .FALSE."
+ }
+}
+
+# Start of test script.
+
+clean_restart
+
+if [set_lang_fortran] then {
+ test_dot_operations
+} else {
+ warning "$test_name tests suppressed." 0
+}
+
projects / binutils-gdb.git / commitdiff