Implement 'Object_Size

This patch started as an attempt to allow the 'Size attribute to be
applied to types, and not just objects.

However, that turns out to be difficult due to the Ada semantcs of
'Size.  In particular, Ada requires 'Size to denote the size of the
representation of the value, so for example Boolean'Size must be 1.
Implementing this properly requires information not readily available
to gdb... and while we could synthesize this information in many
cases, it also seemed to me that this wasn't strictly very useful when
debugging.

So instead, this patch adds support for the 'Object_Size attribute,
which is somewhat closer to 'sizeof'.

Note also that while 'Object_Size is defined for some dynamic types, I
chose not to implement this here, as again this information is not
readily available -- and I think it's preferable to error than to
print something that might be incorrect.

Reviewed-By: Eli Zaretskii <eliz@gnu.org>

gdb/NEWS

@@ -49,6 +49,8 @@
   history has been reached.  It also specifies that the forward execution can
   continue, and the recording will also continue.
 
+* The Ada 'Object_Size attribute is now supported.
+
 * Python API
 
   ** Added gdb.record.clear.  Clears the trace data of the current recording.

gdb/ada-exp.h

@@ -30,10 +30,6 @@ extern struct value *ada_atr_tag (struct type *expect_type,
 				  struct expression *exp,
 				  enum noside noside, enum exp_opcode op,
 				  struct value *arg1);
-extern struct value *ada_atr_size (struct type *expect_type,
-				   struct expression *exp,
-				   enum noside noside, enum exp_opcode op,
-				   struct value *arg1);
 extern struct value *ada_abs (struct type *expect_type,
 			      struct expression *exp,
 			      enum noside noside, enum exp_opcode op,
@@ -200,10 +196,24 @@ public:
 
 using ada_neg_operation = unop_operation<UNOP_NEG, ada_unop_neg>;
 using ada_atr_tag_operation = unop_operation<OP_ATR_TAG, ada_atr_tag>;
-using ada_atr_size_operation = unop_operation<OP_ATR_SIZE, ada_atr_size>;
 using ada_abs_operation = unop_operation<UNOP_ABS, ada_abs>;
 using ada_pos_operation = unop_operation<OP_ATR_POS, ada_pos_atr>;
 
+/* Implementation of the 'Size and 'Object_Size attribute.  The
+   boolean parameter is true for 'Size and false for 'Object_Size.  */
+class ada_atr_size_operation
+  : public maybe_constant_operation<operation_up, bool>
+{
+  using maybe_constant_operation::maybe_constant_operation;
+
+  value *evaluate (struct type *expect_type,
+		   struct expression *exp,
+		   enum noside noside) override;
+
+  enum exp_opcode opcode () const override
+  { return OP_ATR_SIZE; }
+};
+
 /* The in-range operation, given a type.  */
 class ada_unop_range_operation
   : public tuple_holding_operation<operation_up, struct type *>

gdb/ada-exp.y

@@ -185,12 +185,12 @@ ada_pop (bool deprocedure_p = true, struct type *context_type = nullptr)
 }
 
 /* Like parser_state::wrap, but use ada_pop to pop the value.  */
-template<typename T>
+template<typename T, typename... Args>
 void
-ada_wrap ()
+ada_wrap (Args... args)
 {
   operation_up arg = ada_pop ();
-  pstate->push_new<T> (std::move (arg));
+  pstate->push_new<T> (std::move (arg), std::forward<Args> (args)...);
 }
 
 /* Create and push an address-of operation, as appropriate for Ada.
@@ -519,7 +519,7 @@ make_tick_completer (struct stoken tok)
 
 %right TICK_ACCESS TICK_ADDRESS TICK_FIRST TICK_LAST TICK_LENGTH
 %right TICK_MAX TICK_MIN TICK_MODULUS
-%right TICK_POS TICK_RANGE TICK_SIZE TICK_TAG TICK_VAL
+%right TICK_POS TICK_RANGE TICK_SIZE TICK_OBJECT_SIZE TICK_TAG TICK_VAL
 %right TICK_COMPLETE TICK_ENUM_REP TICK_ENUM_VAL
  /* The following are right-associative only so that reductions at this
     precedence have lower precedence than '.' and '('.  The syntax still
@@ -914,7 +914,9 @@ primary :	primary TICK_ACCESS
 			    (std::move (arg), OP_ATR_LENGTH, $3);
 			}
 	|       primary TICK_SIZE
-			{ ada_wrap<ada_atr_size_operation> (); }
+			{ ada_wrap<ada_atr_size_operation> (true); }
+	|       primary TICK_OBJECT_SIZE
+			{ ada_wrap<ada_atr_size_operation> (false); }
 	|	primary TICK_TAG
 			{ ada_wrap<ada_atr_tag_operation> (); }
 	|       opt_type_prefix TICK_MIN '(' exp ',' exp ')'

gdb/ada-lang.c

@@ -10101,15 +10101,28 @@ ada_atr_tag (struct type *expect_type,
   return ada_value_tag (arg1);
 }
 
-/* A helper function for OP_ATR_SIZE.  */
+namespace expr
+{
 
 value *
-ada_atr_size (struct type *expect_type,
+ada_atr_size_operation::evaluate (struct type *expect_type,
-	      struct expression *exp,
+				  struct expression *exp,
-	      enum noside noside, enum exp_opcode op,
+				  enum noside noside)
-	      struct value *arg1)
 {
-  struct type *type = arg1->type ();
+  bool is_type = std::get<0> (m_storage)->opcode () == OP_TYPE;
+  bool is_size = std::get<1> (m_storage);
+
+  enum noside sub_noside = is_type ? EVAL_AVOID_SIDE_EFFECTS : noside;
+  value *val = std::get<0> (m_storage)->evaluate (nullptr, exp, sub_noside);
+  struct type *type = ada_check_typedef (val->type ());
+
+  if (is_type)
+    {
+      if (is_size)
+	error (_("gdb cannot apply 'Size to a type"));
+      if (is_dynamic_type (type) || find_base_type (type) != nullptr)
+	error (_("cannot apply 'Object_Size to dynamic type"));
+    }
 
   /* If the argument is a reference, then dereference its type, since
      the user is really asking for the size of the actual object,
@@ -10124,6 +10137,8 @@ ada_atr_size (struct type *expect_type,
 			       TARGET_CHAR_BIT * type->length ());
 }
 
+} /* namespace expr */
+
 /* A helper function for UNOP_ABS.  */
 
 value *

gdb/ada-lex.l

@@ -672,6 +672,7 @@ attributes[] = {
   { "max", TICK_MAX },
   { "min", TICK_MIN },
   { "modulus", TICK_MODULUS },
+  { "object_size", TICK_OBJECT_SIZE },
   { "pos", TICK_POS },
   { "range", TICK_RANGE },
   { "size", TICK_SIZE },

gdb/doc/gdb.texinfo

@@ -18821,6 +18821,12 @@ operand of the membership (@code{in}) operator.
 
 @item
 @t{'Address}.
+
+@item
+@t{'Size} is available for objects (not types).
+
+@item
+@t{'Object_Size} is available, but not for indefinite types.
 @end itemize
 
 @item

gdb/testsuite/gdb.ada/type-tick-size.exp

@@ -0,0 +1,50 @@
+# Copyright 2024 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/>.
+
+load_lib "ada.exp"
+
+require allow_ada_tests
+
+standard_ada_testfile prog
+
+if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug}] != ""} {
+    return -1
+}
+
+clean_restart ${testfile}
+
+set bp_location [gdb_get_line_number "STOP" ${testdir}/prog.adb]
+runto "prog.adb:$bp_location"
+
+foreach type {boolean color simple small_int} {
+    # Log all the values for easier debugging.
+    gdb_test "print ${type}_val'object_size" " = $decimal"
+    gdb_test "print ${type}'object_size" " = $decimal"
+    gdb_test "print ${type}_size" " = $decimal"
+    gdb_test "print ${type}_type_size" " = $decimal"
+
+    gdb_test "print ${type}_val'object_size = ${type}_size" " = true"
+    gdb_test "print ${type}'object_size = ${type}_type_size" " = true"
+
+    gdb_test "print ${type}'size" "gdb cannot apply 'Size to a type"
+}
+
+gdb_test "print rec_val'object_size" " = $decimal"
+gdb_test "print rec'object_size" "cannot apply 'Object_Size to dynamic type"
+
+# Check that 'Size can be applied to values, regardless of whether
+# their declared type is dynamic.
+gdb_test "print static_blob'size = static_blob_size" " = true"
+gdb_test "print dynamic_blob'size = dynamic_blob_size" " = true"

gdb/testsuite/gdb.ada/type-tick-size/pck.adb

@@ -0,0 +1,21 @@
+--  Copyright 2024 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/>.
+
+package body Pck is
+procedure Do_Nothing (A : System.Address) is
+   begin
+      null;
+   end Do_Nothing;
+end Pck;

gdb/testsuite/gdb.ada/type-tick-size/pck.ads

@@ -0,0 +1,36 @@
+--  Copyright 2024 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/>.
+
+with System;
+with Support; use Support;
+
+package Pck is
+   subtype Length is Natural range 0 .. 10;
+   type Bounded_String (Max_Length : Length := Length'Last) is
+   record
+      Current_Length : Length := 0;
+      Buffer : String (1 .. Max_Length);
+   end record;
+
+   type Blob is array (Integer range <>) of Bounded_String;
+
+   Static_Blob : Blob (1 .. 10);
+   Static_Blob_Size : Integer := Static_Blob'Size;
+
+   Dynamic_Blob : Blob (1 .. Ident (10));
+   Dynamic_Blob_Size : Integer := Dynamic_Blob'Size;
+
+   procedure Do_Nothing (A : System.Address);
+end Pck;

gdb/testsuite/gdb.ada/type-tick-size/prog.adb

@@ -0,0 +1,56 @@
+--  Copyright 2024 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/>.
+
+with Pck; use Pck;
+
+procedure Prog is
+   type Color is (Red, Orange, Yellow, Green, Blue, Indigo, Violet);
+
+   type Simple is record
+      I : Integer;
+   end record;
+
+   subtype Small_Int is Natural range 0 .. 100;
+   type Rec (L : Small_Int := 0) is record
+      S : String (1 .. L);
+   end record;
+
+   Boolean_Val : Boolean := True;
+   Boolean_Size : Integer := Boolean_Val'Size;
+   Boolean_Type_Size : Integer := Boolean'Object_Size;
+
+   Color_Val : Color := Indigo;
+   Color_Size : Integer := Color_Val'Size;
+   Color_Type_Size : Integer := Color'Object_Size;
+
+   Simple_Val : Simple := (I => 91);
+   Simple_Size : Integer := Simple_Val'Size;
+   Simple_Type_Size : Integer := Simple'Object_Size;
+
+   Small_Int_Val : Small_Int := 31;
+   Small_Int_Size : Integer := Small_Int_Val'Size;
+   Small_Int_Type_Size : Integer := Small_Int'Object_Size;
+
+   Rec_Val : Rec := (L => 2, S => "xy");
+   -- This is implementation defined, so the compiler does provide
+   -- something, but gdb does not.
+   Rec_Size : Integer := Rec_Val'Size;
+   Rec_Type_Size : Integer := Rec'Object_Size;
+
+begin
+   Do_Nothing (Static_Blob'Address);
+   Do_Nothing (Dynamic_Blob'Address);
+   null;                        -- STOP
+end Prog;

gdb/testsuite/gdb.ada/type-tick-size/support.adb

@@ -0,0 +1,21 @@
+--  Copyright 2024 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/>.
+
+package body Support is
+   function Ident (I : Integer) return Integer is
+   begin
+      return I;
+   end Ident;
+end Support;

gdb/testsuite/gdb.ada/type-tick-size/support.ads

@@ -0,0 +1,18 @@
+--  Copyright 2024 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/>.
+
+package Support is
+   function Ident (I : Integer) return Integer;
+end Support;