ada: Couple of adjustments coming from aliasing considerations

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.

diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb
index 3f26c3527fa4848ede3c41cdbacd347fb80e60b5..59dfe5df8df4fa3db422a28eea3f77c30383aa36 100644 (file)
--- a/gcc/ada/exp_pakd.adb
+++ b/gcc/ada/exp_pakd.adb
@@ -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;

diff --git a/gcc/ada/libgnat/a-stream.ads b/gcc/ada/libgnat/a-stream.ads
index 0a0cabce3f2b338d208df1b8d8edc30b1f420678..dcb5a9aa81cef2d3d597bd1a82d486e67192c9b0 100644 (file)
--- a/gcc/ada/libgnat/a-stream.ads
+++ b/gcc/ada/libgnat/a-stream.ads
@@ -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;

diff --git a/gcc/ada/libgnat/g-alleve.ads b/gcc/ada/libgnat/g-alleve.ads
index 0f3ec36d0f1b75ab9d9dbeb21595248ff8dab423..4e22a3e6387654da6c6dd92455eb92173ac3270c 100644 (file)
--- a/gcc/ada/libgnat/g-alleve.ads
+++ b/gcc/ada/libgnat/g-alleve.ads
@@ -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 --

diff --git a/gcc/ada/libgnat/g-alleve__hard.ads b/gcc/ada/libgnat/g-alleve__hard.ads
index 5a311c7e2292643a81f6c15bd64e51380421d5bf..88a73b3895371d2682f7f3e52b79c07829b3885c 100644 (file)
--- a/gcc/ada/libgnat/g-alleve__hard.ads
+++ b/gcc/ada/libgnat/g-alleve__hard.ads
@@ -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);
 
    ------------------------------------