From: Andrew Burgess Date: Thu, 11 Feb 2021 13:34:06 +0000 (+0000) Subject: gdb/fortran: support ALLOCATED builtin X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=96df3e28b835ccb5804bcca96f417761e5e8be67;p=binutils-gdb.git gdb/fortran: support ALLOCATED builtin Add support for the ALLOCATED keyword to the Fortran expression parser. gdb/ChangeLog: * f-exp.y (f77_keywords): Add allocated. * f-lang.c (evaluate_subexp_f): Handle UNOP_FORTRAN_ALLOCATED. (operator_length_f): Likewise. (print_subexp_f): Likewise. (dump_subexp_body_f): Likewise. (operator_check_f): Likewise. * std-operator.def (UNOP_FORTRAN_ALLOCATED): New operator. gdb/testsuite/ChangeLog: * gdb.fortran/allocated.exp: New file. * gdb.fortran/allocated.f90: New file. --- diff --git a/gdb/ChangeLog b/gdb/ChangeLog index ff44b8b6678..c71d779ced8 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,13 @@ +2021-02-12 Andrew Burgess + + * f-exp.y (f77_keywords): Add allocated. + * f-lang.c (evaluate_subexp_f): Handle UNOP_FORTRAN_ALLOCATED. + (operator_length_f): Likewise. + (print_subexp_f): Likewise. + (dump_subexp_body_f): Likewise. + (operator_check_f): Likewise. + * std-operator.def (UNOP_FORTRAN_ALLOCATED): New operator. + 2021-02-11 Tom de Vries PR symtab/27353 diff --git a/gdb/f-exp.y b/gdb/f-exp.y index 00f0df34db4..e95a2c974ca 100644 --- a/gdb/f-exp.y +++ b/gdb/f-exp.y @@ -1046,6 +1046,7 @@ static const struct token f77_keywords[] = { "cmplx", BINOP_INTRINSIC, BINOP_FORTRAN_CMPLX, false }, { "lbound", UNOP_OR_BINOP_INTRINSIC, FORTRAN_LBOUND, false }, { "ubound", UNOP_OR_BINOP_INTRINSIC, FORTRAN_UBOUND, false }, + { "allocated", UNOP_INTRINSIC, UNOP_FORTRAN_ALLOCATED, false }, }; /* Implementation of a dynamically expandable buffer for processing input diff --git a/gdb/f-lang.c b/gdb/f-lang.c index 57dd2ed7e31..08ed56a7469 100644 --- a/gdb/f-lang.c +++ b/gdb/f-lang.c @@ -906,6 +906,20 @@ evaluate_subexp_f (struct type *expect_type, struct expression *exp, return value_from_host_double (type, val); } + case UNOP_FORTRAN_ALLOCATED: + { + arg1 = evaluate_subexp (nullptr, exp, pos, noside); + if (noside == EVAL_SKIP) + return eval_skip_value (exp); + type = check_typedef (value_type (arg1)); + if (type->code () != TYPE_CODE_ARRAY) + error (_("ALLOCATED can only be applied to arrays")); + struct type *result_type + = builtin_f_type (exp->gdbarch)->builtin_logical; + LONGEST result_value = type_not_allocated (type) ? 0 : 1; + return value_from_longest (result_type, result_value); + } + case BINOP_FORTRAN_MODULO: { arg1 = evaluate_subexp (nullptr, exp, pos, noside); @@ -1118,6 +1132,7 @@ operator_length_f (const struct expression *exp, int pc, int *oplenp, case UNOP_FORTRAN_KIND: case UNOP_FORTRAN_FLOOR: case UNOP_FORTRAN_CEILING: + case UNOP_FORTRAN_ALLOCATED: oplen = 1; args = 1; break; @@ -1203,6 +1218,10 @@ print_subexp_f (struct expression *exp, int *pos, print_unop_subexp_f (exp, pos, stream, prec, "CEILING"); return; + case UNOP_FORTRAN_ALLOCATED: + print_unop_subexp_f (exp, pos, stream, prec, "ALLOCATED"); + return; + case BINOP_FORTRAN_CMPLX: print_binop_subexp_f (exp, pos, stream, prec, "CMPLX"); return; @@ -1252,6 +1271,7 @@ dump_subexp_body_f (struct expression *exp, case UNOP_FORTRAN_KIND: case UNOP_FORTRAN_FLOOR: case UNOP_FORTRAN_CEILING: + case UNOP_FORTRAN_ALLOCATED: case BINOP_FORTRAN_CMPLX: case BINOP_FORTRAN_MODULO: operator_length_f (exp, (elt + 1), &oplen, &nargs); @@ -1288,6 +1308,7 @@ operator_check_f (struct expression *exp, int pos, case UNOP_FORTRAN_KIND: case UNOP_FORTRAN_FLOOR: case UNOP_FORTRAN_CEILING: + case UNOP_FORTRAN_ALLOCATED: case BINOP_FORTRAN_CMPLX: case BINOP_FORTRAN_MODULO: case FORTRAN_LBOUND: diff --git a/gdb/std-operator.def b/gdb/std-operator.def index aad89990c5b..f3533aa3908 100644 --- a/gdb/std-operator.def +++ b/gdb/std-operator.def @@ -438,6 +438,7 @@ OP (OP_F77_UNDETERMINED_ARGLIST) OP (UNOP_FORTRAN_KIND) OP (UNOP_FORTRAN_FLOOR) OP (UNOP_FORTRAN_CEILING) +OP (UNOP_FORTRAN_ALLOCATED) /* Two operand builtins. */ OP (BINOP_FORTRAN_CMPLX) diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog index 89aaf8b50c4..52b0752276b 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2021-02-12 Andrew Burgess + + * gdb.fortran/allocated.exp: New file. + * gdb.fortran/allocated.f90: New file. + 2021-02-11 Andrew Burgess * gdb.fortran/lbound-ubound.exp: Remove old comment. diff --git a/gdb/testsuite/gdb.fortran/allocated.exp b/gdb/testsuite/gdb.fortran/allocated.exp new file mode 100644 index 00000000000..4391c5eec97 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/allocated.exp @@ -0,0 +1,49 @@ +# 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 . + +# Testing GDB's implementation of ALLOCATED 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 +} + +# Set all the breakpoints. +for { set i 1 } { $i < 6 } { incr i } { + gdb_breakpoint [gdb_get_line_number "Breakpoint $i"] +} + +# Run to each test and check GDB calculates the ALLOCATED value of the +# array variable correctly. We compare to a value calculated within +# the test program itself. +for { set i 1 } { $i < 6 } { incr i } { + with_test_prefix "Breakpoint $i" { + gdb_continue_to_breakpoint "found it" + set expected [get_valueof "" "is_allocated" "*unknown*"] + set calculated [get_valueof "" "allocated (array)" "*missing*"] + gdb_assert { [string eq ${expected} ${calculated}] } \ + "expected and calculated results match" + } +} diff --git a/gdb/testsuite/gdb.fortran/allocated.f90 b/gdb/testsuite/gdb.fortran/allocated.f90 new file mode 100644 index 00000000000..cfca2c809aa --- /dev/null +++ b/gdb/testsuite/gdb.fortran/allocated.f90 @@ -0,0 +1,49 @@ +! 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 . + +! +! Start of test program. +! +program test + + integer, allocatable :: array (:, :) + logical is_allocated + + is_allocated = allocated (array) + print *, is_allocated ! Breakpoint 1 + + ! Allocate or associate any variables as needed. + allocate (array (-5:4, -2:7)) + + is_allocated = allocated (array) + print *, is_allocated ! Breakpoint 2 + + deallocate (array) + + is_allocated = allocated (array) + print *, is_allocated ! Breakpoint 3 + + allocate (array (3:8, 2:7)) + + is_allocated = allocated (array) + print *, is_allocated ! Breakpoint 4 + + ! All done. Deallocate. + deallocate (array) + + is_allocated = allocated (array) + print *, is_allocated ! Breakpoint 5 + +end program test