gdb/fortran: add support for 'SIZE' keyword

[deliverable/binutils-gdb.git] / gdb / f-lang.c

diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index 1b66ae341598605957de656f3b8b01297e81e802..a33aef31d4f2612e9daa6f9ed70bac7edd28c83f 100644 (file)
--- 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 *
@@ -773,6 +870,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
 {