+2021-02-12 Andrew Burgess <andrew.burgess@embecosm.com>
+
+ * 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 <tdevries@suse.de>
PR symtab/27353
{ "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
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);
case UNOP_FORTRAN_KIND:
case UNOP_FORTRAN_FLOOR:
case UNOP_FORTRAN_CEILING:
+ case UNOP_FORTRAN_ALLOCATED:
oplen = 1;
args = 1;
break;
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;
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);
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:
OP (UNOP_FORTRAN_KIND)
OP (UNOP_FORTRAN_FLOOR)
OP (UNOP_FORTRAN_CEILING)
+OP (UNOP_FORTRAN_ALLOCATED)
/* Two operand builtins. */
OP (BINOP_FORTRAN_CMPLX)
+2021-02-12 Andrew Burgess <andrew.burgess@embecosm.com>
+
+ * gdb.fortran/allocated.exp: New file.
+ * gdb.fortran/allocated.f90: New file.
+
2021-02-11 Andrew Burgess <andrew.burgess@embecosm.com>
* gdb.fortran/lbound-ubound.exp: Remove old comment.
--- /dev/null
+# 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 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"
+ }
+}
--- /dev/null
+! 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
+
+ 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
projects / binutils-gdb.git / commitdiff