From 7ba155b37073a3512c85f1d7f12dbaed9a6db3e2 Mon Sep 17 00:00:00 2001
From: Andrew Burgess <andrew.burgess@embecosm.com>
Date: Thu, 25 Feb 2021 16:15:52 +0000
Subject: gdb/fortran: add support for 'SIZE' keyword

Add support for the 'SIZE' keyword to the Fortran expression parser.
This returns the number of elements either in an entire array (passing
a single argument to SIZE), or in a particular dimension of an
array (passing two arguments to SIZE).

At this point I have not added support for the optional third argument
to SIZE, which controls the exact integer type of the result.

gdb/ChangeLog:

	* f-exp.y (eval_op_f_array_size): Declare 1 and 2 argument forms
	of this function.
	(expr::fortran_array_size_1arg): New type.
	(expr::fortran_array_size_2arg): Likewise.
	* f-exp.y (exp): Handle FORTRAN_ARRAY_SIZE after parsing
	UNOP_OR_BINOP_INTRINSIC.
	(f77_keywords): Add "size" keyword.
	* f-lang.c (fortran_array_size): New function.
	(eval_op_f_array_size): New function, has a 1 arg and 2 arg form.
	* std-operator.def (FORTRAN_ARRAY_SIZE): New operator.

gdb/testsuite/ChangeLog:

	* gdb.fortran/size.exp: New file.
	* gdb.fortran/size.f90: New file.
---
 gdb/f-lang.c | 97 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 97 insertions(+)

(limited to 'gdb/f-lang.c')

diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index d30b13d8b6d..a33aef31d4f 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -578,6 +578,103 @@ eval_op_f_associated (struct type *expect_type,
   return fortran_associated (exp->gdbarch, exp->language_defn, arg1, arg2);
 }
 
+/* Implement FORTRAN_ARRAY_SIZE expression, this corresponds to the 'SIZE'
+   keyword.  Both GDBARCH and LANG are extracted from the expression being
+   evaluated.  ARRAY is the value that should be an array, though this will
+   not have been checked before calling this function.  DIM is optional, if
+   present then it should be an integer identifying a dimension of the
+   array to ask about.  As with ARRAY the validity of DIM is not checked
+   before calling this function.
+
+   Return either the total number of elements in ARRAY (when DIM is
+   nullptr), or the number of elements in dimension DIM.  */
+
+static struct value *
+fortran_array_size (struct gdbarch *gdbarch, const language_defn *lang,
+		    struct value *array, struct value *dim_val = nullptr)
+{
+  /* Check that ARRAY is the correct type.  */
+  struct type *array_type = check_typedef (value_type (array));
+  if (array_type->code () != TYPE_CODE_ARRAY)
+    error (_("SIZE can only be applied to arrays"));
+  if (type_not_allocated (array_type) || type_not_associated (array_type))
+    error (_("SIZE can only be used on allocated/associated arrays"));
+
+  int ndimensions = calc_f77_array_dims (array_type);
+  int dim = -1;
+  LONGEST result = 0;
+
+  if (dim_val != nullptr)
+    {
+      if (check_typedef (value_type (dim_val))->code () != TYPE_CODE_INT)
+	error (_("DIM argument to SIZE must be an integer"));
+      dim = (int) value_as_long (dim_val);
+
+      if (dim < 1 || dim > ndimensions)
+	error (_("DIM argument to SIZE must be between 1 and %d"),
+	       ndimensions);
+    }
+
+  /* Now walk over all the dimensions of the array totalling up the
+     elements in each dimension.  */
+  for (int i = ndimensions - 1; i >= 0; --i)
+    {
+      /* If this is the requested dimension then we're done.  Grab the
+	 bounds and return.  */
+      if (i == dim - 1 || dim == -1)
+	{
+	  LONGEST lbound, ubound;
+	  struct type *range = array_type->index_type ();
+
+	  if (!get_discrete_bounds (range, &lbound, &ubound))
+	    error (_("failed to find array bounds"));
+
+	  LONGEST dim_size = (ubound - lbound + 1);
+	  if (result == 0)
+	    result = dim_size;
+	  else
+	    result *= dim_size;
+
+	  if (dim != -1)
+	    break;
+	}
+
+      /* Peel off another dimension of the array.  */
+      array_type = TYPE_TARGET_TYPE (array_type);
+    }
+
+  struct type *result_type
+    = builtin_f_type (gdbarch)->builtin_integer;
+  return value_from_longest (result_type, result);
+}
+
+/* See f-exp.h.  */
+
+struct value *
+eval_op_f_array_size (struct type *expect_type,
+		      struct expression *exp,
+		      enum noside noside,
+		      enum exp_opcode opcode,
+		      struct value *arg1)
+{
+  gdb_assert (opcode == FORTRAN_ARRAY_SIZE);
+  return fortran_array_size (exp->gdbarch, exp->language_defn, arg1);
+}
+
+/* See f-exp.h.  */
+
+struct value *
+eval_op_f_array_size (struct type *expect_type,
+		      struct expression *exp,
+		      enum noside noside,
+		      enum exp_opcode opcode,
+		      struct value *arg1,
+		      struct value *arg2)
+{
+  gdb_assert (opcode == FORTRAN_ARRAY_SIZE);
+  return fortran_array_size (exp->gdbarch, exp->language_defn, arg1, arg2);
+}
+
 /* A helper function for UNOP_ABS.  */
 
 struct value *
-- 
cgit v1.2.1