Patchwork [Ada] Array components of discriminated records with packed parent types

login
register
mail settings
Submitter Arnaud Charlet
Date April 23, 2013, 2:57 p.m.
Message ID <20130423145754.GA9640@adacore.com>
Download mbox | patch
Permalink /patch/238938/
State New
Headers show

Comments

Arnaud Charlet - April 23, 2013, 2:57 p.m.
If a component of a record subtype is constrained by discriminants, and the
component of the parent type is a packed array type, the record subtype and
its components might not be frozen explicitly, in which case the packed array
type of the component type must be constructed explicitly when the component
is created.

Compiling p.adb must yield the following warning:

    p.ads:15:04: warning: pragma Pack causes component size to be 15
    p.ads:15:04: warning: use Component_Size to set desired value

---
package p is

   type Int16 is new Short_Integer;
   for Int16'Size use 16;

   Int16_Last : constant Int16 := Int16'Last;

   subtype Pos16 is Int16 range 1 .. Int16_Last;
   subtype Nat16 is Int16 range 0 .. Int16_Last;
 
   type Abstract_Association_Server is abstract tagged limited null record;

   type Association_Access_At is
         array (Pos16 range <>, Pos16 range <>) of Nat16;
   pragma Pack (Association_Access_At);

   protected type Association_Buffering (Nr_O1 : Nat16; Nr_O2 : Nat16) is
   private
      Association_Access : Association_Access_At (1 .. Nr_O1, 1 .. Nr_O2);
      Created : Boolean := False;
   end Association_Buffering;

   type Association_Server
            (Nr_Associations : Pos16; Nr_O1 : Nat16; Nr_O2 : Nat16)
      is abstract new Abstract_Association_Server
      with record
         Association_Buffer : Association_Buffering (Nr_O1, Nr_O2);
      end record;
end p;
--
package body p is

   protected body Association_Buffering is

      procedure Create is
      begin
         Created := True;
      end Create;

   end Association_Buffering;

end p;

Tested on x86_64-pc-linux-gnu, committed on trunk

2013-04-23  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb: Add exp_pakd to context.
	(Constrain_Component_Type): If the component of the parent is
	packed, and the record subtype being built is already frozen,
	as is the case for an itype, the component type itself will not
	be frozen, and the packed array type for it must be constructed
	explicitly.

Patch

Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb	(revision 198179)
+++ sem_ch3.adb	(working copy)
@@ -35,6 +35,7 @@ 
 with Exp_Ch9;  use Exp_Ch9;
 with Exp_Disp; use Exp_Disp;
 with Exp_Dist; use Exp_Dist;
+with Exp_Pakd; use Exp_Pakd;
 with Exp_Tss;  use Exp_Tss;
 with Exp_Util; use Exp_Util;
 with Fname;    use Fname;
@@ -11113,6 +11114,7 @@ 
    is
       Loc         : constant Source_Ptr := Sloc (Constrained_Typ);
       Compon_Type : constant Entity_Id := Etype (Comp);
+      Array_Comp  : Node_Id;
 
       function Build_Constrained_Array_Type
         (Old_Type : Entity_Id) return Entity_Id;
@@ -11510,8 +11512,20 @@ 
          return Compon_Type;
 
       elsif Is_Array_Type (Compon_Type) then
-         return Build_Constrained_Array_Type (Compon_Type);
+         Array_Comp := Build_Constrained_Array_Type (Compon_Type);
 
+         --  If the component of the parent is packed, and the record type is
+         --  already frozen, as is the case for an itype, the component type
+         --  itself will not be frozen, and the packed array type for it must
+         --  be constructed explicitly.
+
+         if Is_Packed (Compon_Type)
+           and then Is_Frozen (Current_Scope)
+         then
+            Create_Packed_Array_Type (Array_Comp);
+         end if;
+         return Array_Comp;
+
       elsif Has_Discriminants (Compon_Type) then
          return Build_Constrained_Discriminated_Type (Compon_Type);