[Ada] Fix bugs in Value_Size clauses and refactor

gcc/ada/

	* sem_ch13.adb (Analyze_Attribute_Definition_Clause): Combine
	processing of Size and Value_Size clauses. Ensure that
	Value_Size is treated the same as Size, in the cases where both
	are allowed (i.e. the prefix denotes a first subtype).  Misc
	cleanup.
	* einfo-utils.adb (Init_Size): Add assertions.
	(Size_Clause): Return a Value_Size clause if present, instead of
	just looking for a Size clause.
	* einfo.ads (Has_Size_Clause, Size_Clause): Change documentation
	to include Value_Size.
	* sem_ch13.ads, layout.ads, layout.adb: Comment modifications.

6 files changed, 145 insertions, 142 deletions

diff --git a/gcc/ada/einfo-utils.adb b/gcc/ada/einfo-utils.adb
index 6e8a772..22143d6 100644
--- a/gcc/ada/einfo-utils.adb
+++ b/gcc/ada/einfo-utils.adb
@@ -481,7 +481,13 @@ package body Einfo.Utils is
 
    procedure Init_Size (Id : E; V : Int) is
    begin
-      pragma Assert (not Is_Object (Id));
+      pragma Assert (Is_Type (Id));
+      pragma Assert
+        (not Known_Esize (Id) or else Esize (Id) = V);
+      pragma Assert
+        (RM_Size (Id) = No_Uint
+           or else RM_Size (Id) = Uint_0
+           or else RM_Size (Id) = V);
       Set_Esize (Id, UI_From_Int (V));
       Set_RM_Size (Id, UI_From_Int (V));
    end Init_Size;
@@ -492,7 +498,7 @@ package body Einfo.Utils is
 
    procedure Init_Size_Align (Id : E) is
    begin
-      pragma Assert (not Is_Object (Id));
+      pragma Assert (Ekind (Id) in Type_Kind | E_Void);
       Set_Esize (Id, Uint_0);
       Set_RM_Size (Id, Uint_0);
       Set_Alignment (Id, Uint_0);
@@ -2927,8 +2933,13 @@ package body Einfo.Utils is
    -----------------
 
    function Size_Clause (Id : E) return N is
+      Result : N := Get_Attribute_Definition_Clause (Id, Attribute_Size);
    begin
-      return Get_Attribute_Definition_Clause (Id, Attribute_Size);
+      if No (Result) then
+         Result := Get_Attribute_Definition_Clause (Id, Attribute_Value_Size);
+      end if;
+
+      return Result;
    end Size_Clause;
 
    ------------------------
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 2feef7a..6a8d493 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -2015,11 +2015,11 @@ package Einfo is
 --       which at least one of the shift operators is defined.
 
 --    Has_Size_Clause
---       Defined in entities for types and objects. Set if a size clause is
---       defined for the entity. Used to prevent multiple Size clauses for a
---       given entity. Note that it is always initially cleared for a derived
---       type, even though the Size for such a type is inherited from a Size
---       clause given for the parent type.
+--       Defined in entities for types and objects. Set if a size or value size
+--       clause is defined for the entity. Used to prevent multiple clauses
+--       for a given entity. Note that it is always initially cleared for a
+--       derived type, even though the Size or Value_Size clause for such a
+--       type might be inherited from an ancestor type.
 
 --    Has_Small_Clause
 --       Defined in ordinary fixed point types (but not subtypes). Indicates
@@ -4321,13 +4321,12 @@ package Einfo is
 --       suppress this code if a subsequent address clause is encountered.
 
 --    Size_Clause (synthesized)
---       Applies to all entities. If a size clause is present in the rep
---       item chain for an entity then the attribute definition clause node
---       for the size clause is returned. Otherwise Size_Clause returns Empty
---       if no item is present. Usually this is only meaningful if the flag
---       Has_Size_Clause is set. This is because when the representation item
---       chain is copied for a derived type, it can inherit a size clause that
---       is not applicable to the entity.
+--       Applies to all entities. If a size or value size clause is present in
+--       the rep item chain for an entity then that attribute definition clause
+--       is returned. Otherwise Size_Clause returns Empty. Usually this is only
+--       meaningful if the flag Has_Size_Clause is set. This is because when
+--       the representation item chain is copied for a derived type, it can
+--       inherit a size clause that is not applicable to the entity.
 
 --    Size_Depends_On_Discriminant
 --       Defined in all entities for types and subtypes. Indicates that the
diff --git a/gcc/ada/layout.adb b/gcc/ada/layout.adb
index 5bafbcc..6dc4d7f 100644
--- a/gcc/ada/layout.adb
+++ b/gcc/ada/layout.adb
@@ -270,15 +270,15 @@ package body Layout is
             Desig_Type := Non_Limited_View (Designated_Type (E));
          end if;
 
-         --  If Esize already set (e.g. by a size clause), then nothing further
-         --  to be done here.
+         --  If Esize already set (e.g. by a size or value size clause), then
+         --  nothing further to be done here.
 
          if Known_Esize (E) then
             null;
 
-         --  Access to subprogram is a strange beast, and we let the backend
-         --  figure out what is needed (it may be some kind of fat pointer,
-         --  including the static link for example.
+         --  Access to protected subprogram is a strange beast, and we let the
+         --  backend figure out what is needed (it may be some kind of fat
+         --  pointer, including the static link for example).
 
          elsif Is_Access_Protected_Subprogram_Type (E) then
             null;
diff --git a/gcc/ada/layout.ads b/gcc/ada/layout.ads
index 32caee0..89ee5bd 100644
--- a/gcc/ada/layout.ads
+++ b/gcc/ada/layout.ads
@@ -32,10 +32,9 @@ with Types; use Types;
 
 package Layout is
 
-   --  The following procedures are called from Freeze, so all entities
-   --  for types and objects that get frozen (which should be all such
-   --  entities which are seen by the back end) will get laid out by one
-   --  of these two procedures.
+   --  The following procedures are called from Freeze, so all entities for
+   --  types and objects that get frozen (i.e. all types and objects seen by
+   --  the back end) will get laid out by one of these two procedures.
 
    procedure Layout_Type (E : Entity_Id);
    --  This procedure may set or adjust the fields Esize, RM_Size and
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index cdc0083..92d5249 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -7180,109 +7180,136 @@ package body Sem_Ch13 is
                Set_SSO_Set_High_By_Default (Base_Type (U_Ent), False);
             end if;
 
-         ----------
-         -- Size --
-         ----------
+         ------------------------
+         -- Size or Value_Size --
+         ------------------------
 
-         --  Size attribute definition clause
+         --  Size or Value_Size attribute definition clause. These are treated
+         --  the same, except that Size is allowed on objects, and Value_Size
+         --  is allowed on nonfirst subtypes. First subtypes allow both Size
+         --  and Value_Size; the treatment is the same for both.
 
-         when Attribute_Size => Size : declare
+         when Attribute_Size | Attribute_Value_Size => Size : declare
             Size   : constant Uint := Static_Integer (Expr);
-            Etyp   : Entity_Id;
-            Biased : Boolean;
+
+            Attr_Name : constant String :=
+              (if Id = Attribute_Size then "size"
+               elsif Id = Attribute_Value_Size then "value size"
+               else ""); -- can't happen
+            --  Name of the attribute for printing in messages
+
+            OK_Prefix : constant Boolean :=
+              (if Id = Attribute_Size then
+                Ekind (U_Ent) in Type_Kind | Constant_Or_Variable_Kind
+               elsif Id = Attribute_Value_Size then
+                Ekind (U_Ent) in Type_Kind
+               else False); -- can't happen
+            --  For X'Size, X can be a type or object; for X'Value_Size,
+            --  X can be a type. Note that we already checked that 'Size
+            --  can be specified only for a first subytype.
 
          begin
             FOnly := True;
 
-            if Duplicate_Clause then
-               null;
+            if not OK_Prefix then
+               Error_Msg_N (Attr_Name & " cannot be given for &", Nam);
 
-            elsif not Is_Type (U_Ent)
-              and then Ekind (U_Ent) /= E_Variable
-              and then Ekind (U_Ent) /= E_Constant
-            then
-               Error_Msg_N ("size cannot be given for &", Nam);
+            elsif Duplicate_Clause then
+               null;
 
             elsif Is_Array_Type (U_Ent)
               and then not Is_Constrained (U_Ent)
             then
                Error_Msg_N
-                 ("size cannot be given for unconstrained array", Nam);
+                 (Attr_Name & " cannot be given for unconstrained array", Nam);
 
             elsif Size /= No_Uint then
-               if Is_Type (U_Ent) then
-                  Etyp := U_Ent;
-               else
-                  Etyp := Etype (U_Ent);
-               end if;
+               declare
+                  Etyp : constant Entity_Id :=
+                    (if Is_Type (U_Ent) then U_Ent else Etype (U_Ent));
 
-               --  Check size, note that Gigi is in charge of checking that the
-               --  size of an array or record type is OK. Also we do not check
-               --  the size in the ordinary fixed-point case, since it is too
-               --  early to do so (there may be subsequent small clause that
-               --  affects the size). We can check the size if a small clause
-               --  has already been given.
+               begin
+                  --  Check size, note that Gigi is in charge of checking that
+                  --  the size of an array or record type is OK. Also we do not
+                  --  check the size in the ordinary fixed-point case, since
+                  --  it is too early to do so (there may be subsequent small
+                  --  clause that affects the size). We can check the size if
+                  --  a small clause has already been given.
+
+                  if not Is_Ordinary_Fixed_Point_Type (U_Ent)
+                    or else Has_Small_Clause (U_Ent)
+                  then
+                     declare
+                        Biased : Boolean;
+                     begin
+                        Check_Size (Expr, Etyp, Size, Biased);
+                        Set_Biased (U_Ent, N, Attr_Name & " clause", Biased);
+                     end;
+                  end if;
 
-               if not Is_Ordinary_Fixed_Point_Type (U_Ent)
-                 or else Has_Small_Clause (U_Ent)
-               then
-                  Check_Size (Expr, Etyp, Size, Biased);
-                  Set_Biased (U_Ent, N, "size clause", Biased);
-               end if;
+                  --  For types, set RM_Size and Esize if appropriate
 
-               --  For types set RM_Size and Esize if possible
+                  if Is_Type (U_Ent) then
+                     Set_RM_Size (U_Ent, Size);
 
-               if Is_Type (U_Ent) then
-                  Set_RM_Size (U_Ent, Size);
+                     --  If we are specifying the Size or Value_Size of a
+                     --  first subtype, then for elementary types, increase
+                     --  Object_Size to power of 2, but not less than a storage
+                     --  unit in any case (normally this means it will be byte
+                     --  addressable).
 
-                  --  For elementary types, increase Object_Size to power of 2,
-                  --  but not less than a storage unit in any case (normally
-                  --  this means it will be byte addressable).
+                     --  For all other types, nothing else to do, we leave
+                     --  Esize (object size) unset; the back end will set it
+                     --  from the size and alignment in an appropriate manner.
 
-                  --  For all other types, nothing else to do, we leave Esize
-                  --  (object size) unset, the back end will set it from the
-                  --  size and alignment in an appropriate manner.
+                     --  In both cases, we check whether the alignment must be
+                     --  reset in the wake of the size change.
 
-                  --  In both cases, we check whether the alignment must be
-                  --  reset in the wake of the size change.
+                     --  For nonfirst subtypes ('Value_Size only), we do
+                     --  nothing here.
 
-                  if Is_Elementary_Type (U_Ent) then
-                     if Size <= System_Storage_Unit then
-                        Init_Esize (U_Ent, System_Storage_Unit);
-                     elsif Size <= 16 then
-                        Init_Esize (U_Ent, 16);
-                     elsif Size <= 32 then
-                        Init_Esize (U_Ent, 32);
-                     else
-                        Set_Esize  (U_Ent, (Size + 63) / 64 * 64);
+                     if Is_First_Subtype (U_Ent) then
+                        if Is_Elementary_Type (U_Ent) then
+                           if Size <= System_Storage_Unit then
+                              Init_Esize (U_Ent, System_Storage_Unit);
+                           elsif Size <= 16 then
+                              Init_Esize (U_Ent, 16);
+                           elsif Size <= 32 then
+                              Init_Esize (U_Ent, 32);
+                           else
+                              Set_Esize  (U_Ent, (Size + 63) / 64 * 64);
+                           end if;
+
+                           Alignment_Check_For_Size_Change
+                             (U_Ent, Esize (U_Ent));
+                        else
+                           Alignment_Check_For_Size_Change (U_Ent, Size);
+                        end if;
                      end if;
 
-                     Alignment_Check_For_Size_Change (U_Ent, Esize (U_Ent));
-                  else
-                     Alignment_Check_For_Size_Change (U_Ent, Size);
-                  end if;
+                  --  For Object'Size, set Esize only
 
-               --  For objects, set Esize only
+                  else
+                     if Is_Elementary_Type (Etyp)
+                       and then Size /= System_Storage_Unit
+                       and then Size /= 16
+                       and then Size /= 32
+                       and then Size /= 64
+                       and then Size /= System_Max_Integer_Size
+                     then
+                        Error_Msg_Uint_1 := UI_From_Int (System_Storage_Unit);
+                        Error_Msg_Uint_2 :=
+                          UI_From_Int (System_Max_Integer_Size);
+                        Error_Msg_N
+                          ("size for primitive object must be a power of 2 in "
+                           & "the range ^-^", N);
+                     end if;
 
-               else
-                  if Is_Elementary_Type (Etyp)
-                    and then Size /= System_Storage_Unit
-                    and then Size /= 16
-                    and then Size /= 32
-                    and then Size /= 64
-                    and then Size /= System_Max_Integer_Size
-                  then
-                     Error_Msg_Uint_1 := UI_From_Int (System_Storage_Unit);
-                     Error_Msg_Uint_2 := UI_From_Int (System_Max_Integer_Size);
-                     Error_Msg_N
-                       ("size for primitive object must be a power of 2 in "
-                        & "the range ^-^", N);
+                     Set_Esize (U_Ent, Size);
                   end if;
 
-                  Set_Esize (U_Ent, Size);
-               end if;
-
-               Set_Has_Size_Clause (U_Ent);
+                  Set_Has_Size_Clause (U_Ent);
+               end;
             end if;
          end Size;
 
@@ -7744,39 +7771,6 @@ package body Sem_Ch13 is
             end if;
          end Stream_Size;
 
-         ----------------
-         -- Value_Size --
-         ----------------
-
-         --  Value_Size attribute definition clause
-
-         when Attribute_Value_Size => Value_Size : declare
-            Size   : constant Uint := Static_Integer (Expr);
-            Biased : Boolean;
-
-         begin
-            if not Is_Type (U_Ent) then
-               Error_Msg_N ("Value_Size cannot be given for &", Nam);
-
-            elsif Duplicate_Clause then
-               null;
-
-            elsif Is_Array_Type (U_Ent)
-              and then not Is_Constrained (U_Ent)
-            then
-               Error_Msg_N
-                 ("Value_Size cannot be given for unconstrained array", Nam);
-
-            else
-               if Is_Elementary_Type (U_Ent) then
-                  Check_Size (Expr, U_Ent, Size, Biased);
-                  Set_Biased (U_Ent, N, "value size clause", Biased);
-               end if;
-
-               Set_RM_Size (U_Ent, Size);
-            end if;
-         end Value_Size;
-
          -----------------------
          -- Variable_Indexing --
          -----------------------
diff --git a/gcc/ada/sem_ch13.ads b/gcc/ada/sem_ch13.ads
index 7579812..3b21484 100644
--- a/gcc/ada/sem_ch13.ads
+++ b/gcc/ada/sem_ch13.ads
@@ -115,17 +115,17 @@ package Sem_Ch13 is
       Siz    : Uint;
       Biased : out Boolean);
    --  Called when size Siz is specified for subtype T. This subprogram checks
-   --  that the size is appropriate, posting errors on node N as required.
-   --  This check is effective for elementary types and bit-packed arrays.
-   --  For other non-elementary types, a check is only made if an explicit
-   --  size has been given for the type (and the specified size must match).
-   --  The parameter Biased is set False if the size specified did not require
-   --  the use of biased representation, and True if biased representation
-   --  was required to meet the size requirement. Note that Biased is only
-   --  set if the type is not currently biased, but biasing it is the only
-   --  way to meet the requirement. If the type is currently biased, then
-   --  this biased size is used in the initial check, and Biased is False.
-   --  For a Component_Size clause, T is the component type.
+   --  that the size is appropriate, posting errors on node N as required. This
+   --  check is effective for elementary types and bit-packed arrays. For
+   --  composite types, a check is only made if an explicit size has been given
+   --  for the type (and the specified size must match).  The parameter Biased
+   --  is set False if the size specified did not require the use of biased
+   --  representation, and True if biased representation was required to meet
+   --  the size requirement. Note that Biased is only set if the type is not
+   --  currently biased, but biasing it is the only way to meet the
+   --  requirement. If the type is currently biased, then this biased size is
+   --  used in the initial check, and Biased is False. For a Component_Size
+   --  clause, T is the component type.
 
    function Has_Compatible_Representation
      (Target_Type, Operand_Type : Entity_Id) return Boolean;