@@ -598,6 +598,14 @@ package body Exp_Pakd is
Set_Associated_Node_For_Itype (PAT, Typ);
Set_Original_Array_Type (PAT, Typ);
+ -- In the case of a constrained array type, also set fields on the
+ -- implicit base type built during the analysis of its declaration.
+
+ if Ekind (PAT) = E_Array_Subtype then
+ Set_Is_Packed_Array_Impl_Type (Etype (PAT), True);
+ Set_Original_Array_Type (Etype (PAT), Base_Type (Typ));
+ end if;
+
-- Propagate representation aspects
Set_Is_Atomic (PAT, Is_Atomic (Typ));
@@ -818,7 +826,7 @@ package body Exp_Pakd is
Subtype_Marks => Indexes,
Component_Definition =>
Make_Component_Definition (Loc,
- Aliased_Present => False,
+ Aliased_Present => Has_Aliased_Components (Typ),
Subtype_Indication =>
New_Occurrence_Of (Ctyp, Loc)));
@@ -828,7 +836,7 @@ package body Exp_Pakd is
Discrete_Subtype_Definitions => Indexes,
Component_Definition =>
Make_Component_Definition (Loc,
- Aliased_Present => False,
+ Aliased_Present => Has_Aliased_Components (Typ),
Subtype_Indication =>
New_Occurrence_Of (Ctyp, Loc)));
end if;
@@ -84,4 +84,7 @@ private
for Stream_Element_Array'Read use Read_SEA;
for Stream_Element_Array'Write use Write_SEA;
+ pragma Universal_Aliasing (Stream_Element);
+ -- This type is used to stream any other type
+
end Ada.Streams;
@@ -313,22 +313,62 @@ private
---------------------------------------
-- We simply use the natural array definitions corresponding to each
- -- user-level vector type.
+ -- user-level vector type. We need to put pragma Universal_Aliasing
+ -- on these types because the common operations are implemented by
+ -- means of Unchecked_Conversion betwwen different representations.
- type LL_VUI is new VUI_View;
- type LL_VSI is new VSI_View;
- type LL_VBI is new VBI_View;
+ --------------------------
+ -- char Core Components --
+ --------------------------
+
+ type LL_VUC is new VUC_View;
+ pragma Universal_Aliasing (LL_VUC);
+
+ type LL_VSC is new VSC_View;
+ pragma Universal_Aliasing (LL_VSC);
+
+ type LL_VBC is new VBC_View;
+ pragma Universal_Aliasing (LL_VBC);
+
+ ---------------------------
+ -- short Core Components --
+ ---------------------------
type LL_VUS is new VUS_View;
+ pragma Universal_Aliasing (LL_VUS);
+
type LL_VSS is new VSS_View;
+ pragma Universal_Aliasing (LL_VSS);
+
type LL_VBS is new VBS_View;
+ pragma Universal_Aliasing (LL_VBS);
- type LL_VUC is new VUC_View;
- type LL_VSC is new VSC_View;
- type LL_VBC is new VBC_View;
+ -------------------------
+ -- int Core Components --
+ -------------------------
+
+ type LL_VUI is new VUI_View;
+ pragma Universal_Aliasing (LL_VUI);
+
+ type LL_VSI is new VSI_View;
+ pragma Universal_Aliasing (LL_VSI);
+
+ type LL_VBI is new VBI_View;
+ pragma Universal_Aliasing (LL_VBI);
+
+ ---------------------------
+ -- Float Core Components --
+ ---------------------------
type LL_VF is new VF_View;
+ pragma Universal_Aliasing (LL_VF);
+
+ ---------------------------
+ -- pixel Core Components --
+ ---------------------------
+
type LL_VP is new VP_View;
+ pragma Universal_Aliasing (LL_VP);
------------------------------------
-- Low level functional interface --
@@ -326,16 +326,19 @@ private
type LL_VUC is array (1 .. 16) of unsigned_char;
for LL_VUC'Alignment use VECTOR_ALIGNMENT;
pragma Machine_Attribute (LL_VUC, "vector_type");
+ pragma Universal_Aliasing (LL_VUC);
pragma Suppress (All_Checks, LL_VUC);
type LL_VSC is array (1 .. 16) of signed_char;
for LL_VSC'Alignment use VECTOR_ALIGNMENT;
pragma Machine_Attribute (LL_VSC, "vector_type");
+ pragma Universal_Aliasing (LL_VSC);
pragma Suppress (All_Checks, LL_VSC);
type LL_VBC is array (1 .. 16) of unsigned_char;
for LL_VBC'Alignment use VECTOR_ALIGNMENT;
pragma Machine_Attribute (LL_VBC, "vector_type");
+ pragma Universal_Aliasing (LL_VBC);
pragma Suppress (All_Checks, LL_VBC);
---------------------------
@@ -345,16 +348,19 @@ private
type LL_VUS is array (1 .. 8) of unsigned_short;
for LL_VUS'Alignment use VECTOR_ALIGNMENT;
pragma Machine_Attribute (LL_VUS, "vector_type");
+ pragma Universal_Aliasing (LL_VUS);
pragma Suppress (All_Checks, LL_VUS);
type LL_VSS is array (1 .. 8) of signed_short;
for LL_VSS'Alignment use VECTOR_ALIGNMENT;
pragma Machine_Attribute (LL_VSS, "vector_type");
+ pragma Universal_Aliasing (LL_VSS);
pragma Suppress (All_Checks, LL_VSS);
type LL_VBS is array (1 .. 8) of unsigned_short;
for LL_VBS'Alignment use VECTOR_ALIGNMENT;
pragma Machine_Attribute (LL_VBS, "vector_type");
+ pragma Universal_Aliasing (LL_VBS);
pragma Suppress (All_Checks, LL_VBS);
-------------------------
@@ -364,16 +370,19 @@ private
type LL_VUI is array (1 .. 4) of unsigned_int;
for LL_VUI'Alignment use VECTOR_ALIGNMENT;
pragma Machine_Attribute (LL_VUI, "vector_type");
+ pragma Universal_Aliasing (LL_VUI);
pragma Suppress (All_Checks, LL_VUI);
type LL_VSI is array (1 .. 4) of signed_int;
for LL_VSI'Alignment use VECTOR_ALIGNMENT;
pragma Machine_Attribute (LL_VSI, "vector_type");
+ pragma Universal_Aliasing (LL_VSI);
pragma Suppress (All_Checks, LL_VSI);
type LL_VBI is array (1 .. 4) of unsigned_int;
for LL_VBI'Alignment use VECTOR_ALIGNMENT;
pragma Machine_Attribute (LL_VBI, "vector_type");
+ pragma Universal_Aliasing (LL_VBI);
pragma Suppress (All_Checks, LL_VBI);
---------------------------
@@ -383,6 +392,7 @@ private
type LL_VF is array (1 .. 4) of Float;
for LL_VF'Alignment use VECTOR_ALIGNMENT;
pragma Machine_Attribute (LL_VF, "vector_type");
+ pragma Universal_Aliasing (LL_VF);
pragma Suppress (All_Checks, LL_VF);
---------------------------
@@ -392,6 +402,7 @@ private
type LL_VP is array (1 .. 8) of pixel;
for LL_VP'Alignment use VECTOR_ALIGNMENT;
pragma Machine_Attribute (LL_VP, "vector_type");
+ pragma Universal_Aliasing (LL_VP);
pragma Suppress (All_Checks, LL_VP);
------------------------------------
From: Eric Botcazou <ebotcazou@adacore.com> The first adjustment is to the expansion of implementation types for array types with peculiar index types, for which the aliased property set on the component of the original type must be copied; the implicit base type also needs to be properly marked if the implementation type is constrained. The second adjustment is to selected types in the runtime, which need to be marked with pragma Universal_Aliasing because of their special usage. gcc/ada/ * exp_pakd.adb (Create_Packed_Array_Impl_Type): For non-bit-packed array types, propagate the aliased property of the component. (Install_PAT): Set fields on the implicit base type of an array. * libgnat/a-stream.ads (private part): Add pragma Universal_Aliasing for Stream_Element. * libgnat/g-alleve.ads: Add pragma Universal_Aliasing for all the vector types. * libgnat/g-alleve__hard.ads: Likewise. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_pakd.adb | 12 +++++-- gcc/ada/libgnat/a-stream.ads | 3 ++ gcc/ada/libgnat/g-alleve.ads | 54 ++++++++++++++++++++++++++---- gcc/ada/libgnat/g-alleve__hard.ads | 11 ++++++ 4 files changed, 71 insertions(+), 9 deletions(-)