@@ -5853,26 +5853,51 @@ package body Exp_Aggr is
-- raise Constraint_Error;
-- end if;
+ -- in the general case, but the following simpler test:
+
+ -- [constraint_error when
+ -- Aggr_Lo + (Nb_Elements - 1) > Aggr_Hi];
+
+ -- instead if the index type is a signed integer.
+
elsif Nb_Elements > Uint_0 then
- Cond :=
- Make_Op_Gt (Loc,
- Left_Opnd =>
- Make_Op_Add (Loc,
- Left_Opnd =>
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (Ind_Typ, Loc),
- Attribute_Name => Name_Pos,
- Expressions =>
- New_List
- (Duplicate_Subexpr_Move_Checks (Aggr_Lo))),
- Right_Opnd => Make_Integer_Literal (Loc, Nb_Elements - 1)),
+ if Nb_Elements = Uint_1 then
+ Cond :=
+ Make_Op_Gt (Loc,
+ Left_Opnd => Duplicate_Subexpr_Move_Checks (Aggr_Lo),
+ Right_Opnd => Duplicate_Subexpr_Move_Checks (Aggr_Hi));
+
+ elsif Is_Signed_Integer_Type (Ind_Typ) then
+ Cond :=
+ Make_Op_Gt (Loc,
+ Left_Opnd =>
+ Make_Op_Add (Loc,
+ Left_Opnd => Duplicate_Subexpr_Move_Checks (Aggr_Lo),
+ Right_Opnd =>
+ Make_Integer_Literal (Loc, Nb_Elements - 1)),
+ Right_Opnd => Duplicate_Subexpr_Move_Checks (Aggr_Hi));
- Right_Opnd =>
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (Ind_Typ, Loc),
- Attribute_Name => Name_Pos,
- Expressions => New_List (
- Duplicate_Subexpr_Move_Checks (Aggr_Hi))));
+ else
+ Cond :=
+ Make_Op_Gt (Loc,
+ Left_Opnd =>
+ Make_Op_Add (Loc,
+ Left_Opnd =>
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Ind_Typ, Loc),
+ Attribute_Name => Name_Pos,
+ Expressions =>
+ New_List
+ (Duplicate_Subexpr_Move_Checks (Aggr_Lo))),
+ Right_Opnd => Make_Integer_Literal (Loc, Nb_Elements - 1)),
+
+ Right_Opnd =>
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Ind_Typ, Loc),
+ Attribute_Name => Name_Pos,
+ Expressions => New_List (
+ Duplicate_Subexpr_Move_Checks (Aggr_Hi))));
+ end if;
-- If we are dealing with an aggregate containing an others choice
-- and discrete choices we generate the following test:
@@ -1096,12 +1096,10 @@ package body Exp_Attr is
Selector_Name => Make_Identifier (Loc, Nam));
-- The generated call is given the provided set of parameters, and then
- -- wrapped in a conversion which converts the result to the target type
- -- We use the base type as the target because a range check may be
- -- required.
+ -- wrapped in a conversion which converts the result to the target type.
Rewrite (N,
- Unchecked_Convert_To (Base_Type (Etype (N)),
+ Convert_To (Typ,
Make_Function_Call (Loc,
Name => Fnm,
Parameter_Associations => Args)));
@@ -6011,12 +6009,13 @@ package body Exp_Attr is
if Is_Access_Type (Ptyp) then
if Present (Storage_Size_Variable (Root_Type (Ptyp))) then
Rewrite (N,
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (Typ, Loc),
- Attribute_Name => Name_Max,
- Expressions => New_List (
- Make_Integer_Literal (Loc, 0),
- Convert_To (Typ,
+ Convert_To (Typ,
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of
+ (Etype (Storage_Size_Variable (Root_Type (Ptyp))), Loc),
+ Attribute_Name => Name_Max,
+ Expressions => New_List (
+ Make_Integer_Literal (Loc, 0),
New_Occurrence_Of
(Storage_Size_Variable (Root_Type (Ptyp)), Loc)))));
@@ -6069,7 +6068,7 @@ package body Exp_Attr is
else
Rewrite (N,
- OK_Convert_To (Typ,
+ Convert_To (Typ,
Make_Function_Call (Loc,
Name =>
New_Occurrence_Of (Alloc_Op, Loc),
@@ -265,9 +265,7 @@ 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, and also the
- -- conversion of an integer literal to a dynamic integer type.
+ -- have been applied. This rewrites the conversion into a simpler form.
function Unique_Fixed_Point_Type (N : Node_Id) return Entity_Id;
-- A universal_fixed expression in an universal context is unambiguous if
@@ -12630,7 +12628,7 @@ package body Sem_Res is
-- 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.
+ -- to avoid doing range checks in universal integer.
elsif Is_Integer_Type (Target_Typ)
and then not Is_Generic_Type (Root_Type (Target_Typ))
@@ -12639,6 +12637,17 @@ package body Sem_Res is
then
Convert_To_And_Rewrite (Root_Type (Target_Typ), Operand);
Analyze_And_Resolve (Operand);
+
+ -- If the expression is a conversion to universal integer of an
+ -- an expression with an integer type, then we can eliminate the
+ -- intermediate conversion to universal integer.
+
+ elsif Nkind (Operand) = N_Type_Conversion
+ and then Entity (Subtype_Mark (Operand)) = Universal_Integer
+ and then Is_Integer_Type (Etype (Expression (Operand)))
+ then
+ Rewrite (Operand, Relocate_Node (Expression (Operand)));
+ Analyze_And_Resolve (Operand);
end if;
end;
end if;
@@ -119,16 +119,6 @@ package body Tbuild is
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),