Toolchain/binutils-gdb
1
0
Fork 0
forked from Imagelibrary/binutils-gdb
Code Pull Requests Activity

gdb/fortran: add support for RANK keyword

Browse Source 
gfortran supports the RANK keyword, see:

  https://gcc.gnu.org/onlinedocs/gfortran/RANK.html#RANK

this commit adds support for this keyword to GDB's Fortran expression
parser.

gdb/ChangeLog:

	* f-exp.h (eval_op_f_rank): Declare.
	(expr::fortran_rank_operation): New typedef.
	* f-exp.y (exp): Handle UNOP_FORTRAN_RANK after parsing an
	UNOP_INTRINSIC.
	(f77_keywords): Add "rank" keyword.
	* f-lang.c (eval_op_f_rank): New function.
	* std-operator.def (UNOP_FORTRAN_RANK): New operator.

gdb/testsuite/ChangeLog:

	* gdb.fortran/rank.exp: New file.
	* gdb.fortran/rank.f90: New file.
This commit is contained in:
Andrew Burgess
2021-02-25 11:41:57 +00:00
parent 742732c7f0
commit e14816a8ba
8 changed files with 189 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
gdb/ChangeLog
View File

@@ -1,3 +1,13 @@
2021-03-09 Andrew Burgess <andrew.burgess@embecosm.com>
* f-exp.h (eval_op_f_rank): Declare.
(expr::fortran_rank_operation): New typedef.
* f-exp.y (exp): Handle UNOP_FORTRAN_RANK after parsing an
UNOP_INTRINSIC.
(f77_keywords): Add "rank" keyword.
* f-lang.c (eval_op_f_rank): New function.
* std-operator.def (UNOP_FORTRAN_RANK): New operator.
2021-03-08 Tom Tromey <tom@tromey.com>
* printcmd.c (set_command): Remove null check.

13
gdb/f-exp.h
View File

@@ -74,6 +74,17 @@ extern struct value * eval_op_f_allocated (struct type *expect_type,
enum exp_opcode op,
struct value *arg1);
/* Implement the evaluation of UNOP_FORTRAN_RANK. EXPECTED_TYPE, EXP, and
NOSIDE are as for expression::evaluate (see expression.h). OP will
always be UNOP_FORTRAN_RANK, and ARG1 is the argument being passed to
the expression. */
extern struct value *eval_op_f_rank (struct type *expect_type,
struct expression *exp,
enum noside noside,
enum exp_opcode op,
struct value *arg1);
namespace expr
{
@@ -94,6 +105,8 @@ using fortran_associated_1arg = unop_operation<FORTRAN_ASSOCIATED,
eval_op_f_associated>;
using fortran_associated_2arg = binop_operation<FORTRAN_ASSOCIATED,
eval_op_f_associated>;
using fortran_rank_operation = unop_operation<UNOP_FORTRAN_RANK,
eval_op_f_rank>;
/* The Fortran "complex" operation. */
class fortran_cmplx_operation

4
gdb/f-exp.y
View File

@@ -320,6 +320,9 @@ exp : UNOP_INTRINSIC '(' exp ')'
case UNOP_FORTRAN_ALLOCATED:
pstate->wrap<fortran_allocated_operation> ();
break;
case UNOP_FORTRAN_RANK:
pstate->wrap<fortran_rank_operation> ();
break;
default:
gdb_assert_not_reached ("unhandled intrinsic");
}
@@ -1139,6 +1142,7 @@ static const struct token f77_keywords[] =
{ "ubound", UNOP_OR_BINOP_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 },
};
/* Implementation of a dynamically expandable buffer for processing input

20
gdb/f-lang.c
View File

@@ -773,6 +773,26 @@ eval_op_f_allocated (struct type *expect_type, struct expression *exp,
return value_from_longest (result_type, result_value);
}
/* See f-exp.h. */
struct value *
eval_op_f_rank (struct type *expect_type,
struct expression *exp,
enum noside noside,
enum exp_opcode op,
struct value *arg1)
{
gdb_assert (op == UNOP_FORTRAN_RANK);
struct type *result_type
= builtin_f_type (exp->gdbarch)->builtin_integer;
struct type *type = check_typedef (value_type (arg1));
if (type->code () != TYPE_CODE_ARRAY)
return value_from_longest (result_type, 0);
LONGEST ndim = calc_f77_array_dims (type);
return value_from_longest (result_type, ndim);
}
namespace expr
{

1
gdb/std-operator.def
View File

@@ -378,6 +378,7 @@ OP (UNOP_FORTRAN_KIND)
OP (UNOP_FORTRAN_FLOOR)
OP (UNOP_FORTRAN_CEILING)
OP (UNOP_FORTRAN_ALLOCATED)
OP (UNOP_FORTRAN_RANK)
/* Two operand builtins. */
OP (BINOP_FORTRAN_CMPLX)

5
gdb/testsuite/ChangeLog
View File

@@ -1,3 +1,8 @@
2021-03-09 Andrew Burgess <andrew.burgess@embecosm.com>
* gdb.fortran/rank.exp: New file.
* gdb.fortran/rank.f90: New file.
2021-03-08 Tom Tromey <tom@tromey.com>
* gdb.fortran/debug-expr.exp: Update tests.

79
gdb/testsuite/gdb.fortran/rank.exp Normal file
View File

@@ -0,0 +1,79 @@
# Copyright 2021 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/> .
# Testing GDB's implementation of RANK keyword.
if {[skip_fortran_tests]} { return -1 }
standard_testfile ".f90"
load_lib fortran.exp
if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
{debug f90}]} {
return -1
}
if ![fortran_runto_main] {
untested "could not run to main"
return -1
}
gdb_breakpoint [gdb_get_line_number "Test Breakpoint"]
gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
# We place a limit on the number of tests that can be run, just in
# case something goes wrong, and GDB gets stuck in an loop here.
set found_final_breakpoint false
set test_count 0
while { $test_count < 500 } {
with_test_prefix "test $test_count" {
incr test_count
gdb_test_multiple "continue" "continue" {
-re -wrap "! Test Breakpoint" {
# We can run a test from here.
}
-re "! Final Breakpoint" {
# We're done with the tests.
set found_final_breakpoint true
}
}
if ($found_final_breakpoint) {
break
}
# First grab the expected answer.
set answer [get_valueof "" "answer" "**unknown**"]
# Now move up a frame and figure out a command for us to run
# as a test.
set command ""
gdb_test_multiple "up" "up" {
-re -wrap "\r\n\[0-9\]+\[ \t\]+call test_rank \\((\[^\r\n\]+)\\)" {
set command $expect_out(1,string)
}
}
gdb_assert { ![string equal $command ""] } "found a command to run"
gdb_test "p $command" " = $answer"
}
}
# Ensure we reached the final breakpoint. If more tests have been added
# to the test script, and this starts failing, then the safety 'while'
# loop above might need to be increased.
gdb_assert {$found_final_breakpoint} "ran all compiled in tests"

57
gdb/testsuite/gdb.fortran/rank.f90 Normal file
View File

@@ -0,0 +1,57 @@
! Copyright 2021 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/>.
!
! Start of test program.
!
program test
! Things to ask questions about.
integer, target :: array_1d (8:10) = 0
integer, target :: array_2d (1:3, 4:7) = 0
integer :: other_1d (4:5, -3:-1, 99:101) = 0
integer, pointer :: array_1d_p (:) => null ()
integer, pointer :: array_2d_p (:,:) => null ()
integer :: an_integer = 0
real :: a_real = 0.0
! The start of the tests.
call test_rank (rank (array_1d))
call test_rank (rank (array_2d))
call test_rank (rank (other_1d))
call test_rank (rank (array_1d_p))
call test_rank (rank (array_2d_p))
array_1d_p => array_1d
array_2d_p => array_2d
call test_rank (rank (array_1d_p))
call test_rank (rank (array_2d_p))
call test_rank (rank (an_integer))
call test_rank (rank (a_real))
print *, "" ! Final Breakpoint
contains
subroutine test_rank (answer)
integer :: answer
print *,answer ! Test Breakpoint
end subroutine test_rank
end program test