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.

7 files changed, 136 insertions, 0 deletions

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index ff44b8b..c71d779 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,13 @@
+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
diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index 00f0df3..e95a2c9 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 57dd2ed..08ed56a 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 aad8999..f3533aa 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 89aaf8b..52b0752 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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.
diff --git a/gdb/testsuite/gdb.fortran/allocated.exp b/gdb/testsuite/gdb.fortran/allocated.exp
new file mode 100644
index 0000000..4391c5e
--- /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 <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"
+    }
+}
diff --git a/gdb/testsuite/gdb.fortran/allocated.f90 b/gdb/testsuite/gdb.fortran/allocated.f90
new file mode 100644
index 0000000..cfca2c8
--- /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 <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