[Ada] Get rid of more references to Universal_Integer in expanded code

2020-06-02  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* exp_aggr.adb (Build_Array_Aggr_Code): Set the type of the PAT
	on the zero used to clear the array.
	* exp_attr.adb (Expand_N_Attribute_Reference)
	<Attribute_Alignment>: In the CW case, directly convert from the
	alignment's type to the target type if the parent is an
	unchecked conversion.
	* sem_res.adb (Set_String_Literal_Subtype): In the dynamic case,
	use the general expression for the upper bound only when needed.
	Set the base type of the index as the type of the low bound.
	(Simplify_Type_Conversion): Do an intermediate conversion to the
	root type of the target type if the operand is an integer
	literal.
	* tbuild.adb (Convert_To): Get rid of an intermediate conversion
	to Universal_Integer if the inner expression has integer tyoe.
	* libgnat/a-sequio.adb (Byte_Swap): Make use of an equivalent
	static expression in the case statement.

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index f4b959516d761de44c1974beaecd59b8f9d1d0bf..05508d821d4dea42ec6687b9b45ecc913a9924ab 100644 (file)
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -2043,12 +2043,15 @@ package body Exp_Aggr is
         and then Is_Bit_Packed_Array (Typ)
         and then Is_Modular_Integer_Type (Packed_Array_Impl_Type (Typ))
       then
-         Append_To (New_Code,
-           Make_Assignment_Statement (Loc,
-             Name       => New_Copy_Tree (Into),
-             Expression =>
-               Unchecked_Convert_To (Typ,
-                 Make_Integer_Literal (Loc, Uint_0))));
+         declare
+            Zero : constant Node_Id := Make_Integer_Literal (Loc, Uint_0);
+         begin
+            Analyze_And_Resolve (Zero, Packed_Array_Impl_Type (Typ));
+            Append_To (New_Code,
+              Make_Assignment_Statement (Loc,
+                Name       => New_Copy_Tree (Into),
+                Expression => Unchecked_Convert_To (Typ, Zero)));
+         end;
       end if;
 
       --  If the component type contains tasks, we need to build a Master

diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 731d223122c73da10b31be9efd475bd5ea96dbb9..a4957b38f59c887dd88bb1561dbf4c4fd65a4b4b 100644 (file)
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -2459,12 +2459,20 @@ package body Exp_Attr is
 
             New_Node := Build_Get_Alignment (Loc, New_Node);
 
+            --  Case where the context is an unchecked conversion to a specific
+            --  integer type. We directly convert from the alignment's type.
+
+            if Nkind (Parent (N)) = N_Unchecked_Type_Conversion then
+               Rewrite (N, New_Node);
+               Analyze_And_Resolve (N);
+               return;
+
             --  Case where the context is a specific integer type with which
             --  the original attribute was compatible. But the alignment has a
             --  specific type in a-tags.ads (Standard.Natural) so, in order to
             --  preserve type compatibility, we must convert explicitly.
 
-            if Typ /= Standard_Natural then
+            elsif Typ /= Standard_Natural then
                New_Node := Convert_To (Typ, New_Node);
             end if;
 

diff --git a/gcc/ada/libgnat/a-sequio.adb b/gcc/ada/libgnat/a-sequio.adb
index 9519a871fa597e1e30a5d033c464b20174d63ae1..95a95a2d372409886e88eec8271e0c13e78f659b 100644 (file)
--- a/gcc/ada/libgnat/a-sequio.adb
+++ b/gcc/ada/libgnat/a-sequio.adb
@@ -73,7 +73,7 @@ package body Ada.Sequential_IO is
    procedure Byte_Swap (Siz : in out size_t) is
       use System.Byte_Swapping;
    begin
-      case Siz'Size is
+      case size_t'Size is
          when 32     => Siz := size_t (Bswap_32 (U32 (Siz)));
          when 64     => Siz := size_t (Bswap_64 (U64 (Siz)));
          when others => raise Program_Error;

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 21cbe0aa8a58556ad3da61e098ced07ff26ad5f4..ee9772cfca83b7f57eed504736946050212c82e0 100644 (file)
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -266,7 +266,8 @@ package body Sem_Res is
    procedure Simplify_Type_Conversion (N : Node_Id);
    --  Called after N has been resolved and evaluated, but before range checks
    --  have been applied. Currently simplifies a combination of floating-point
-   --  to integer conversion and Rounding or Truncation attribute.
+   --  to integer conversion and Rounding or Truncation attribute, and also the
+   --  conversion of an integer literal to a dynamic integer type.
 
    function Unique_Fixed_Point_Type (N : Node_Id) return Entity_Id;
    --  A universal_fixed expression in an universal context is unambiguous if
@@ -12477,37 +12478,51 @@ package body Sem_Res is
 
       --  If the lower bound is not static we create a range for the string
       --  literal, using the index type and the known length of the literal.
-      --  The index type is not necessarily Positive, so the upper bound is
-      --  computed as T'Val (T'Pos (Low_Bound) + L - 1).
+      --  If the length is 1, then the upper bound is set to a mere copy of
+      --  the lower bound; or else, if the index type is a signed integer,
+      --  then the upper bound is computed as Low_Bound + L - 1; otherwise,
+      --  the upper bound is computed as T'Val (T'Pos (Low_Bound) + L - 1).
 
       else
          declare
-            Index_List : constant List_Id   := New_List;
-            Index_Type : constant Entity_Id := Etype (First_Index (Typ));
-            High_Bound : constant Node_Id   :=
-                           Make_Attribute_Reference (Loc,
-                             Attribute_Name => Name_Val,
-                             Prefix         =>
-                               New_Occurrence_Of (Index_Type, Loc),
-                             Expressions    => New_List (
-                               Make_Op_Add (Loc,
-                                 Left_Opnd  =>
-                                   Make_Attribute_Reference (Loc,
-                                     Attribute_Name => Name_Pos,
-                                     Prefix         =>
-                                       New_Occurrence_Of (Index_Type, Loc),
-                                     Expressions    =>
-                                       New_List (New_Copy_Tree (Low_Bound))),
-                                 Right_Opnd =>
-                                   Make_Integer_Literal (Loc,
-                                     String_Length (Strval (N)) - 1))));
-
+            Length        : constant Nat := String_Length (Strval (N));
+            Index_List    : constant List_Id   := New_List;
+            Index_Type    : constant Entity_Id := Etype (First_Index (Typ));
             Array_Subtype : Entity_Id;
             Drange        : Node_Id;
+            High_Bound    : Node_Id;
             Index         : Node_Id;
             Index_Subtype : Entity_Id;
 
          begin
+            if Length = 1 then
+               High_Bound := New_Copy_Tree (Low_Bound);
+
+            elsif Is_Signed_Integer_Type (Index_Type) then
+               High_Bound :=
+                 Make_Op_Add (Loc,
+                   Left_Opnd  => New_Copy_Tree (Low_Bound),
+                   Right_Opnd => Make_Integer_Literal (Loc, Length - 1));
+
+            else
+               High_Bound :=
+                 Make_Attribute_Reference (Loc,
+                   Attribute_Name => Name_Val,
+                   Prefix         =>
+                     New_Occurrence_Of (Index_Type, Loc),
+                   Expressions    => New_List (
+                     Make_Op_Add (Loc,
+                       Left_Opnd  =>
+                         Make_Attribute_Reference (Loc,
+                           Attribute_Name => Name_Pos,
+                           Prefix         =>
+                             New_Occurrence_Of (Index_Type, Loc),
+                           Expressions    =>
+                             New_List (New_Copy_Tree (Low_Bound))),
+                       Right_Opnd =>
+                         Make_Integer_Literal (Loc, Length - 1))));
+            end if;
+
             if Is_Integer_Type (Index_Type) then
                Set_String_Literal_Low_Bound
                  (Subtype_Id, Make_Integer_Literal (Loc, 1));
@@ -12522,10 +12537,10 @@ package body Sem_Res is
                     Attribute_Name => Name_First,
                     Prefix         =>
                       New_Occurrence_Of (Base_Type (Index_Type), Loc)));
-               Set_Etype (String_Literal_Low_Bound (Subtype_Id), Index_Type);
             end if;
 
-            Analyze_And_Resolve (String_Literal_Low_Bound (Subtype_Id));
+            Analyze_And_Resolve
+              (String_Literal_Low_Bound (Subtype_Id), Base_Type (Index_Type));
 
             --  Build bona fide subtype for the string, and wrap it in an
             --  unchecked conversion, because the back end expects the
@@ -12611,6 +12626,19 @@ package body Sem_Res is
                     Relocate_Node (First (Expressions (Operand))));
                   Set_Float_Truncate (N, Truncate);
                end;
+
+            --  Special processing for the conversion of an integer literal to
+            --  a dynamic type: we first convert the literal to the root type
+            --  and then convert the result to the target type, the goal being
+            --  to avoid doing range checks in Universal_Integer type.
+
+            elsif Is_Integer_Type (Target_Typ)
+              and then not Is_Generic_Type (Root_Type (Target_Typ))
+              and then Nkind (Operand) = N_Integer_Literal
+              and then Opnd_Typ = Universal_Integer
+            then
+               Convert_To_And_Rewrite (Root_Type (Target_Typ), Operand);
+               Analyze_And_Resolve (Operand);
             end if;
          end;
       end if;

diff --git a/gcc/ada/tbuild.adb b/gcc/ada/tbuild.adb
index bb5532d9b8f2642fa9cbeb9dd1f5aa2c4721c2e2..1302d97ea85cd0489373650fe9ceca57b78ab236 100644 (file)
--- a/gcc/ada/tbuild.adb
+++ b/gcc/ada/tbuild.adb
@@ -116,10 +116,19 @@ package body Tbuild is
       Result : Node_Id;
 
    begin
-      if Present (Etype (Expr))
-        and then (Etype (Expr)) = Typ
-      then
+      if Present (Etype (Expr)) and then Etype (Expr) = Typ then
          return Relocate_Node (Expr);
+
+      --  Case where the expression is a conversion to universal integer of
+      --  an expression with an integer type, and we can thus eliminate the
+      --  intermediate conversion to universal integer.
+
+      elsif Nkind (Expr) = N_Type_Conversion
+        and then Entity (Subtype_Mark (Expr)) = Universal_Integer
+        and then Is_Integer_Type (Etype (Expression (Expr)))
+      then
+         return Convert_To (Typ, Expression (Expr));
+
       else
          Result :=
            Make_Type_Conversion (Sloc (Expr),
@@ -853,8 +862,8 @@ package body Tbuild is
       then
          return Relocate_Node (Expr);
 
-      --  Cases where the inner expression is itself an unchecked conversion
-      --  to the same type, and we can thus eliminate the outer conversion.
+      --  Case where the expression is itself an unchecked conversion to
+      --  the same type, and we can thus eliminate the outer conversion.
 
       elsif Nkind (Expr) = N_Unchecked_Type_Conversion
         and then Entity (Subtype_Mark (Expr)) = Typ