From: Javier Miranda <[email protected]>
Revert patch for Is_Modular_Integer_Type and Is_Signed_Integer_Type;
add new synthesized predicates Has_Modular_Operations and
Has_Overflow_Operations, and adjust the frontend sources
to rely on them.
gcc/ada/ChangeLog:
* einfo.ads (Has_Unsigned_Base_Range_Aspect): Update documentation.
(Has_Modular_Operations): New synthesized predicate.
(Has_Overflow_Operations): New synthesized predicate.
* einfo-utils.ads (Has_Modular_Operations): New function.
(Has_Overflow_Operations): New function.
* einfo-utils.adb (Is_Modular_Integer_Type): Undo previous patch.
(Is_Signed_Integer_Type): Undo previous patch.
(Has_Modular_Operations): New function.
(Has_Overflow_Operations): New function.
* checks.adb (Determine_Range): Replace selected occurrences of calls to
Is_Modular_Integer_Type by calls to Has_Modular_Operations, and calls to
Is_Signed_Integer_Type by calls to Has Overflow_Operations.
(Enable_Range_Check): Ditto.
(Insert_Valid_Check): Ditto.
* exp_aggr.adb (Others_Check): Ditto.
* exp_attr.adb (Expand_N_Attribute_Reference [Attribute_Pred,
Attribute_Succ]): Ditto.
* exp_ch4.adb (Expand_Compare_Minimize_Eliminate_Overflow): Ditto.
(Size_In_Storage_Elements): Ditto.
(Expand_N_Op_Abs): Ditto.
(Expand_N_Op_Expon): Ditto.
(Expand_N_Op_Minus): Ditto.
(Expand_N_Op_Multiply): Ditto.
(Expand_N_Op_Subtract): Ditto.
* freeze.adb (Freeze_Entity): Ditto.
* sem_aggr.adb (Report_Null_Array_Constraint_Error): Ditto plus
report specific error for index with unsigned_base_range aspect.
* sem_attr.adb (Check_Modular_Integer_Type): Ditto.
(Analyze_Attribute [Attribute_Pred, Attribute_Succ, Attribute_
Range_Length, Attribute_Small, Attribute_Reduce]): Ditto.
* sem_ch12.adb (Instantiate_Type): Ditto.
(Validate_Formal_Type_Default): Ditto.
* sem_ch13.adb (Valid_Empty): Ditto.
* sem_ch2.adb (Analyze_Integer_Literal): Ditto.
* sem_ch3.adb (Unsigned_Base_Range_Type_Declaration): Set attribute
Has_Unsigned_Base_Range_Aspect on the implicit base, and set Etype
of its first subtype E_Modular_Integer_Subtype.
* sem_ch4.adb (Analyze_Call): Ditto.
* sem_eval.adb (Check_Non_Static_Context_For_Overflow): Ditto.
(Eval_Arithmetic_Op): Ditto.
(Eval_Integer_Literal): Ditto.
(Eval_Logical_Op): Ditto.
(Eval_Op_Expon): Ditto.
(Eval_Op_Not): Ditto.
(Eval_Unary_Op): Ditto.
(Fold_Shift): Ditto.
(Test_Expression_Is_Foldable): Ditto.
* sem_intr.adb (Check_Shift): Ditto.
* sem_prag.adb (Analyze_Pragma [Pragma_Unsigned_Base_Range]): Add
assertion.
* sem_res.adb (Resolve_Logical_Op): Ditto.
(Resolve_Unary_Op): Ditto.
(Set_String_Literal_Subtype): Ditto.
* sem_type.adb (Covers): Ditto.
(Specific_Type): Ditto.
(Valid_Boolean_Arg): Ditto.
* sem_util.adb (Wrong_Type): Ditto
* style.adb (Check_Boolean_Operator): Ditto.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/checks.adb | 14 ++++----------
gcc/ada/einfo-utils.adb | 29 +++++++++++++++++++++++------
gcc/ada/einfo-utils.ads | 2 ++
gcc/ada/einfo.ads | 22 ++++++++++++++++++----
gcc/ada/exp_aggr.adb | 2 +-
gcc/ada/exp_attr.adb | 4 ++--
gcc/ada/exp_ch4.adb | 38 ++++++++++++--------------------------
gcc/ada/freeze.adb | 2 +-
gcc/ada/sem_aggr.adb | 9 ++++++++-
gcc/ada/sem_attr.adb | 12 ++++++------
gcc/ada/sem_ch12.adb | 8 ++++----
gcc/ada/sem_ch13.adb | 2 +-
gcc/ada/sem_ch2.adb | 2 +-
gcc/ada/sem_ch3.adb | 9 +++++----
gcc/ada/sem_ch4.adb | 4 ++--
gcc/ada/sem_eval.adb | 39 ++++++++++++++++++++-------------------
gcc/ada/sem_intr.adb | 2 +-
gcc/ada/sem_prag.adb | 9 +++++++--
gcc/ada/sem_res.adb | 6 +++---
gcc/ada/sem_type.adb | 8 ++++----
gcc/ada/sem_util.adb | 2 +-
gcc/ada/style.adb | 2 +-
22 files changed, 127 insertions(+), 100 deletions(-)
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 0577a9ec53d..a943d009353 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -5532,9 +5532,7 @@ package body Checks is
-- bound, because that means the result could wrap.
-- Same applies for the lower bound if it is negative.
- if Is_Modular_Integer_Type (Typ)
- and then not Has_Unsigned_Base_Range_Aspect (Btyp)
- then
+ if Has_Modular_Operations (Typ) then
if Lor > Lo and then Hir <= Hbound then
Lo := Lor;
end if;
@@ -6263,11 +6261,9 @@ package body Checks is
if Overflow_Checks_Suppressed (Etype (N)) then
return;
- -- Nothing to do for unsigned integer types, which do not overflow
+ -- Nothing to do for modular integer types, which do not overflow
- elsif Is_Modular_Integer_Type (Typ)
- and then not Has_Unsigned_Base_Range_Aspect (Typ)
- then
+ elsif Has_Modular_Operations (Typ) then
return;
end if;
@@ -8158,9 +8154,7 @@ package body Checks is
elsif Nkind (Expr) = N_Selected_Component
and then Present (Component_Clause (Entity (Selector_Name (Expr))))
- and then
- (Is_Modular_Integer_Type (Typ)
- and then not Has_Unsigned_Base_Range_Aspect (Base_Type (Typ)))
+ and then Has_Modular_Operations (Typ)
and then Modulus (Typ) = 2 ** Esize (Entity (Selector_Name (Expr)))
then
return;
diff --git a/gcc/ada/einfo-utils.adb b/gcc/ada/einfo-utils.adb
index 6d10a7fc4a8..22f50221ddc 100644
--- a/gcc/ada/einfo-utils.adb
+++ b/gcc/ada/einfo-utils.adb
@@ -333,8 +333,7 @@ package body Einfo.Utils is
function Is_Modular_Integer_Type (Id : E) return B is
begin
- return Ekind (Id) in Modular_Integer_Kind
- and then not Has_Unsigned_Base_Range_Aspect (Base_Type (Id));
+ return Ekind (Id) in Modular_Integer_Kind;
end Is_Modular_Integer_Type;
function Is_Named_Access_Type (Id : E) return B is
@@ -394,10 +393,7 @@ package body Einfo.Utils is
function Is_Signed_Integer_Type (Id : E) return B is
begin
- return Ekind (Id) in Signed_Integer_Kind
- or else
- (Ekind (Id) in Modular_Integer_Kind
- and then Has_Unsigned_Base_Range_Aspect (Base_Type (Id)));
+ return Ekind (Id) in Signed_Integer_Kind;
end Is_Signed_Integer_Type;
function Is_Subprogram (Id : E) return B is
@@ -1260,6 +1256,16 @@ package body Einfo.Utils is
and then Present (Limited_View (Id));
end Has_Limited_View;
+ ----------------------------
+ -- Has_Modular_Operations --
+ ----------------------------
+
+ function Has_Modular_Operations (Id : E) return B is
+ begin
+ return Is_Modular_Integer_Type (Id)
+ and then not Has_Unsigned_Base_Range_Aspect (Base_Type (Id));
+ end Has_Modular_Operations;
+
--------------------------
-- Has_Non_Limited_View --
--------------------------
@@ -1349,6 +1355,17 @@ package body Einfo.Utils is
and then Nkind (Node (First_Elmt (Constits))) = N_Null;
end Has_Null_Visible_Refinement;
+ -----------------------------
+ -- Has_Overflow_Operations --
+ -----------------------------
+
+ function Has_Overflow_Operations (Id : E) return B is
+ begin
+ return Is_Signed_Integer_Type (Id)
+ or else (Is_Modular_Integer_Type (Id)
+ and then Has_Unsigned_Base_Range_Aspect (Base_Type (Id)));
+ end Has_Overflow_Operations;
+
--------------------
-- Has_Unmodified --
--------------------
diff --git a/gcc/ada/einfo-utils.ads b/gcc/ada/einfo-utils.ads
index 27cf9e670f0..212caf0ddf2 100644
--- a/gcc/ada/einfo-utils.ads
+++ b/gcc/ada/einfo-utils.ads
@@ -186,11 +186,13 @@ package Einfo.Utils is
function Has_Interrupt_Handler (Id : E) return B;
function Has_Invariants (Id : E) return B;
function Has_Limited_View (Id : E) return B;
+ function Has_Modular_Operations (Id : E) return B with Inline;
function Has_Non_Limited_View (Id : E) return B with Inline;
function Has_Non_Null_Abstract_State (Id : E) return B;
function Has_Non_Null_Visible_Refinement (Id : E) return B;
function Has_Null_Abstract_State (Id : E) return B;
function Has_Null_Visible_Refinement (Id : E) return B;
+ function Has_Overflow_Operations (Id : E) return B with Inline;
function Implementation_Base_Type (Id : E) return E;
function Is_Boolean_Type (Id : E) return B with Inline;
function Is_Constant_Object (Id : E) return B with Inline;
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index e54351340bd..398424c7b81 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -2186,9 +2186,21 @@ package Einfo is
-- inherited in certain contexts.
-- Has_Unsigned_Base_Range_Aspect [base type only]
--- Defined in integer types. Set in the base type of an integer type for
--- which the type has an Unsigned_Base_Range of True (whether by an
--- aspect_specification, a pragma, or inheritance).
+-- Defined in modular integer types. This flag is set in the base type
+-- generated by the frontend for a signed integer type that has an
+-- Unsigned_Base_Range of True (whether by an aspect_specification, a
+-- pragma, or inheritance).
+
+-- Has_Modular_Operations (synthesized)
+-- Defined in modular integer types. True when the type has modular
+-- operations; that is, when its base type does NOT have the attribute
+-- Unsigned_Base_Range_Aspect set to True.
+
+-- Has_Overflow_Operations (synthesized)
+-- Defined in signed integer types and modular integer types. True when
+-- the type has overflow operations; that is, when the type is either
+-- (1) a signed integer type, or (2) a modular integer type and its
+-- base type has the attribute Unsigned_Base_Range_Aspect.
-- Has_Visible_Refinement
-- Defined in E_Abstract_State entities. Set when a state has at least
@@ -5782,6 +5794,8 @@ package Einfo is
-- Non_Binary_Modulus (base type only)
-- Has_Biased_Representation
-- Has_Shift_Operator (base type only)
+ -- Has_Modular_Operations (synth)
+ -- Has_Overflow_Operations (synth)
-- Has_Unsigned_Base_Range_Aspect (base type only)
-- No_Predicate_On_Actual
-- No_Dynamic_Predicate_On_Actual
@@ -6169,8 +6183,8 @@ package Einfo is
-- Scalar_Range
-- Static_Discrete_Predicate
-- Has_Biased_Representation
+ -- Has_Overflow_Operations (synth)
-- Has_Shift_Operator (base type only)
- -- Has_Unsigned_Base_Range_Aspect (base type only)
-- No_Predicate_On_Actual
-- No_Dynamic_Predicate_On_Actual
-- Type_Low_Bound (synth)
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index d195fb044d5..0a0c857b45e 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -5777,7 +5777,7 @@ package body Exp_Aggr is
Left_Opnd => Duplicate_Subexpr_Move_Checks (Aggr_Lo),
Right_Opnd => Duplicate_Subexpr_Move_Checks (Aggr_Hi));
- elsif Is_Signed_Integer_Type (Ind_Typ) then
+ elsif Has_Overflow_Operations (Ind_Typ) then
Cond :=
Make_Op_Gt (Loc,
Left_Opnd =>
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 29c64b7e0c2..578e4410e87 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -6222,7 +6222,7 @@ package body Exp_Attr is
-- For modular types, nothing to do (no overflow, since wraps)
- elsif Is_Modular_Integer_Type (Ptyp) then
+ elsif Has_Modular_Operations (Ptyp) then
null;
-- For other types, if argument is marked as needing a range check or
@@ -7497,7 +7497,7 @@ package body Exp_Attr is
-- For modular types, nothing to do (no overflow, since wraps)
- elsif Is_Modular_Integer_Type (Ptyp) then
+ elsif Has_Modular_Operations (Ptyp) then
null;
-- For other types, if argument is marked as needing a range check or
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 520ab683a6e..1c9dc07b4ff 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -2240,7 +2240,7 @@ package body Exp_Ch4 is
-- Note: Entity for the comparison may be wrong, but it's not worth
-- the effort to change it, since the back end does not use it.
- if Is_Signed_Integer_Type (Ltype)
+ if Has_Overflow_Operations (Ltype)
and then Base_Type (Ltype) = Base_Type (Rtype)
then
return;
@@ -4386,7 +4386,7 @@ package body Exp_Ch4 is
for J in 1 .. Number_Dimensions (E) loop
- if not Is_Modular_Integer_Type (Etype (Idx)) then
+ if not Has_Modular_Operations (Etype (Idx)) then
Len :=
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (E, Loc),
@@ -7825,7 +7825,7 @@ package body Exp_Ch4 is
-- Deal with software overflow checking
- if Is_Signed_Integer_Type (Typ)
+ if Has_Overflow_Operations (Typ)
and then Do_Overflow_Check (N)
then
-- The only case to worry about is when the argument is equal to the
@@ -7898,11 +7898,8 @@ package body Exp_Ch4 is
-- Arithmetic overflow checks for signed integer/fixed point types,
-- and signed integer types with unsigned base range aspect.
- if Is_Signed_Integer_Type (Typ)
+ if Has_Overflow_Operations (Typ)
or else Is_Fixed_Point_Type (Typ)
- or else
- (Is_Modular_Integer_Type (Typ)
- and then Has_Unsigned_Base_Range_Aspect (Base_Type (Typ)))
then
Apply_Arithmetic_Overflow_Check (N);
return;
@@ -9073,7 +9070,7 @@ package body Exp_Ch4 is
-- therefore we might need to generate an overflow check here
-- if the type is signed.
- if Is_Signed_Integer_Type (Typ) and then Ovflo then
+ if Has_Overflow_Operations (Typ) and then Ovflo then
declare
OK : Boolean;
Lo : Uint;
@@ -9112,7 +9109,7 @@ package body Exp_Ch4 is
-- First deal with modular case
- if Is_Modular_Integer_Type (Rtyp) then
+ if Has_Modular_Operations (Rtyp) then
-- Nonbinary modular case, we call the special exponentiation
-- routine for the nonbinary case, converting the argument to
@@ -9173,7 +9170,7 @@ package body Exp_Ch4 is
-- checks are required, and one when they are not required, since there
-- is a real gain in omitting checks on many machines.
- elsif Is_Signed_Integer_Type (Rtyp) then
+ elsif Has_Overflow_Operations (Rtyp) then
if Esize (Rtyp) <= Standard_Integer_Size then
Etyp := Standard_Integer;
@@ -9494,11 +9491,7 @@ package body Exp_Ch4 is
end if;
if not Backend_Overflow_Checks_On_Target
- and then
- (Is_Signed_Integer_Type (Typ)
- or else
- (Is_Modular_Integer_Type (Typ)
- and then Has_Unsigned_Base_Range_Aspect (Base_Type (Typ))))
+ and then Has_Overflow_Operations (Typ)
and then Do_Overflow_Check (N)
then
-- Software overflow checking expands -expr into (0 - expr)
@@ -9809,7 +9802,7 @@ package body Exp_Ch4 is
-- If the result is modular, perform the reduction of the result
-- appropriately.
- if Is_Modular_Integer_Type (Typ)
+ if Has_Modular_Operations (Typ)
and then not Non_Binary_Modulus (Typ)
then
Rewrite (N,
@@ -9837,7 +9830,7 @@ package body Exp_Ch4 is
-- Same processing for the operands the other way round
elsif Lp2 then
- if Is_Modular_Integer_Type (Typ)
+ if Has_Modular_Operations (Typ)
and then not Non_Binary_Modulus (Typ)
then
Rewrite (N,
@@ -9922,11 +9915,7 @@ package body Exp_Ch4 is
-- Non-fixed point cases, check software overflow checking required
- elsif Is_Signed_Integer_Type (Etype (N))
- or else
- (Is_Modular_Integer_Type (Typ)
- and then Has_Unsigned_Base_Range_Aspect (Base_Type (Typ)))
- then
+ elsif Has_Overflow_Operations (Etype (N)) then
Apply_Arithmetic_Overflow_Check (N);
end if;
@@ -10493,11 +10482,8 @@ package body Exp_Ch4 is
-- Arithmetic overflow checks for signed integer/fixed point types,
-- and signed integer types with unsigned base range aspect.
- if Is_Signed_Integer_Type (Typ)
+ if Has_Overflow_Operations (Typ)
or else Is_Fixed_Point_Type (Typ)
- or else
- (Is_Modular_Integer_Type (Typ)
- and then Has_Unsigned_Base_Range_Aspect (Base_Type (Typ)))
then
Apply_Arithmetic_Overflow_Check (N);
end if;
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 439462569bd..fc39cc7b9da 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -7713,7 +7713,7 @@ package body Freeze is
elsif Is_Integer_Type (E) then
Adjust_Esize_For_Alignment (E);
- if Is_Modular_Integer_Type (E) then
+ if Has_Modular_Operations (E) then
-- Standard_Address has been built with the assumption that its
-- modulus was System_Address_Size, but this is not a universal
-- property and may need to be corrected.
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index baca06800ab..8e079f6b76a 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -1136,10 +1136,17 @@ package body Sem_Aggr is
begin
Error_Msg_Warn := SPARK_Mode /= On;
- if Is_Modular_Integer_Type (Index_Typ) then
+ if Has_Modular_Operations (Index_Typ) then
Error_Msg_N
("null array aggregate indexed by a modular type<<", N);
+ elsif Is_Modular_Integer_Type (Index_Typ)
+ and then Has_Unsigned_Base_Range_Aspect (Base_Type (Index_Typ))
+ then
+ Error_Msg_N
+ ("null array aggregate indexed by an unsigned base range type<<",
+ N);
+
elsif Is_Enumeration_Type (Index_Typ) then
Error_Msg_N
("null array aggregate indexed by an enumeration type<<", N);
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 1393363f0b7..d38e71a01c6 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -2387,7 +2387,7 @@ package body Sem_Attr is
begin
Check_Type;
- if not Is_Modular_Integer_Type (P_Type) then
+ if not Has_Modular_Operations (P_Type) then
Error_Attr_P
("prefix of % attribute must be modular integer type");
end if;
@@ -5778,7 +5778,7 @@ package body Sem_Attr is
-- If not modular type, test for overflow check required
else
- if not Is_Modular_Integer_Type (P_Type)
+ if not Has_Modular_Operations (P_Type)
and then not Range_Checks_Suppressed (P_Base_Type)
then
Enable_Range_Check (E1);
@@ -10221,7 +10221,7 @@ package body Sem_Attr is
-- Modular integer case (wraps)
- elsif Is_Modular_Integer_Type (P_Type) then
+ elsif Has_Modular_Operations (P_Type) then
Fold_Uint (N, (Expr_Value (E1) - 1) mod Modulus (P_Type), Static);
-- Other scalar cases
@@ -10611,7 +10611,7 @@ package body Sem_Attr is
-- Modular integer case (wraps)
- elsif Is_Modular_Integer_Type (P_Type) then
+ elsif Has_Modular_Operations (P_Type) then
Fold_Uint (N, (Expr_Value (E1) + 1) mod Modulus (P_Type), Static);
-- Other scalar cases
@@ -13146,8 +13146,8 @@ package body Sem_Attr is
when Name_Op_And | Name_Op_Or | Name_Op_Xor =>
-- No Boolean array operators in Standard
- return Is_Modular_Integer_Type (Accum_Typ)
- or else Is_Boolean_Type (Accum_Typ);
+ return Is_Boolean_Type (Accum_Typ)
+ or else Has_Modular_Operations (Accum_Typ);
when Name_Op_Concat =>
return Is_Array_Type (Accum_Typ)
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index d3403074ce4..750c2c1a06f 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -15794,7 +15794,7 @@ package body Sem_Ch12 is
Diagnose_Predicated_Actual;
when N_Formal_Signed_Integer_Type_Definition =>
- if not Is_Signed_Integer_Type (Act_T) then
+ if not Has_Overflow_Operations (Act_T) then
Error_Msg_NE
("expect signed integer type in instantiation of&",
Actual, Gen_T);
@@ -15804,7 +15804,7 @@ package body Sem_Ch12 is
Diagnose_Predicated_Actual;
when N_Formal_Modular_Type_Definition =>
- if not Is_Modular_Integer_Type (Act_T) then
+ if not Has_Modular_Operations (Act_T) then
Error_Msg_NE
("expect modular type in instantiation of &",
Actual, Gen_T);
@@ -19230,13 +19230,13 @@ package body Sem_Ch12 is
end if;
when N_Formal_Signed_Integer_Type_Definition =>
- if not Is_Integer_Type (Def_Sub) then
+ if not Has_Overflow_Operations (Def_Sub) then
Error_Msg_NE ("default for& must be a discrete type",
Default, Formal);
end if;
when N_Formal_Modular_Type_Definition =>
- if not Is_Modular_Integer_Type (Def_Sub) then
+ if not Has_Modular_Operations (Def_Sub) then
Error_Msg_NE ("default for& must be a modular_integer Type",
Default, Formal);
end if;
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index b90c7301895..a4c97cd05f0 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -18166,7 +18166,7 @@ package body Sem_Ch13 is
elsif Ekind (E) = E_Function then
return No (First_Formal (E))
or else
- (Is_Signed_Integer_Type (Etype (First_Formal (E)))
+ (Has_Overflow_Operations (Etype (First_Formal (E)))
and then No (Next_Formal (First_Formal (E))));
else
return False;
diff --git a/gcc/ada/sem_ch2.adb b/gcc/ada/sem_ch2.adb
index 8807bf6cec1..df4aa6a4b55 100644
--- a/gcc/ada/sem_ch2.adb
+++ b/gcc/ada/sem_ch2.adb
@@ -124,7 +124,7 @@ package body Sem_Ch2 is
-- prior analysis (or construction) of the literal, and after type
-- checking and resolution.
- if No (Etype (N)) or else not Is_Modular_Integer_Type (Etype (N)) then
+ if No (Etype (N)) or else not Has_Modular_Operations (Etype (N)) then
Set_Etype (N, Universal_Integer);
end if;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index e302908e9db..994f60dc9a7 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -11313,9 +11313,8 @@ package body Sem_Ch3 is
-- not. It is OK for the new bound we are creating, but not for
-- the old one??? Still if it never happens, no problem.
- -- This must be disabled on unsigned base range types because their
- -- base type is a modular type, and their type is a signed integer
- -- type.
+ -- This must be disabled on types with the unsigned base range aspect
+ -- to avoid reporting spurious errors.
if not Has_Unsigned_Base_Range_Aspect (Base_Type (Par_T)) then
Analyze_And_Resolve (Bound, Base_Type (Par_T));
@@ -24100,7 +24099,9 @@ package body Sem_Ch3 is
Set_Scalar_Range (Implicit_Base, Scalar_Range (Base_Typ));
Set_Modulus (Implicit_Base, Modulus (Base_Typ));
- Mutate_Ekind (T, E_Signed_Integer_Subtype);
+ Set_Has_Unsigned_Base_Range_Aspect (Implicit_Base);
+
+ Mutate_Ekind (T, E_Modular_Integer_Subtype);
Set_Etype (T, Implicit_Base);
Set_Size_Info (T, Implicit_Base);
Inherit_Rep_Item_Chain (T, Implicit_Base);
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index a735637d0e3..8d9270dab50 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -1491,12 +1491,12 @@ package body Sem_Ch4 is
Typ := Etype (Arg);
end if;
- if Is_Signed_Integer_Type (Typ) then
+ if Has_Overflow_Operations (Typ) then
Error_Msg_N
("possible missing instantiation of "
& "'Text_'I'O.'Integer_'I'O!", Nam);
- elsif Is_Modular_Integer_Type (Typ) then
+ elsif Has_Modular_Operations (Typ) then
Error_Msg_N
("possible missing instantiation of "
& "'Text_'I'O.'Modular_'I'O!", Nam);
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 7e146fe71bc..be372e76678 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -666,7 +666,7 @@ package body Sem_Eval is
is
begin
if (not Stat or else In_Inlined_Body)
- and then Is_Signed_Integer_Type (Etype (N))
+ and then Has_Overflow_Operations (Etype (N))
then
declare
BT : constant Entity_Id := Base_Type (Etype (N));
@@ -1494,8 +1494,8 @@ package body Sem_Eval is
-- the types are not modular (e.g. X < X + 1 is False if X is
-- the largest number).
- if not Is_Modular_Integer_Type (Ltyp)
- and then not Is_Modular_Integer_Type (Rtyp)
+ if not Has_Modular_Operations (Ltyp)
+ and then not Has_Modular_Operations (Rtyp)
then
if Loffs < Roffs then
Diff.all := Roffs - Loffs;
@@ -2094,7 +2094,7 @@ package body Sem_Eval is
-- Adjust the result by the modulus if the type is a modular type
- if Is_Modular_Integer_Type (Ltype) then
+ if Has_Modular_Operations (Ltype) then
Result := Result mod Modulus (Ltype);
end if;
@@ -2826,7 +2826,7 @@ package body Sem_Eval is
-- Modular integer literals must be in their base range
- if Is_Modular_Integer_Type (Typ)
+ if Has_Modular_Operations (Typ)
and then Is_Out_Of_Range (N, Base_Type (Typ), Assume_Valid => True)
then
Out_Of_Range (N);
@@ -2969,7 +2969,7 @@ package body Sem_Eval is
-- Compile time evaluation of logical operation
- if Is_Modular_Integer_Type (Etype (N)) then
+ if Has_Modular_Operations (Etype (N)) then
Left_Int := Expr_Value (Left);
Right_Int := Expr_Value (Right);
@@ -3206,7 +3206,7 @@ package body Sem_Eval is
Result := Left_Int;
end if;
- if Is_Modular_Integer_Type (Etype (N)) then
+ if Has_Modular_Operations (Etype (N)) then
Result := Result mod Modulus (Etype (N));
end if;
@@ -3277,7 +3277,7 @@ package body Sem_Eval is
-- the original value. For a nonbinary modulus this is an arbitrary
-- but consistent definition.
- if Is_Modular_Integer_Type (Typ) then
+ if Has_Modular_Operations (Typ) then
Fold_Uint (N, Modulus (Typ) - 1 - Rint, Stat);
else pragma Assert (Is_Boolean_Type (Typ));
Fold_Uint (N, Test (not Is_True (Rint)), Stat);
@@ -4388,7 +4388,7 @@ package body Sem_Eval is
Result := Rint;
elsif Nkind (N) = N_Op_Minus then
- if Is_Modular_Integer_Type (Etype (N)) then
+ if Has_Modular_Operations (Etype (N)) then
Result := (-Rint) mod Modulus (Etype (N));
else
Result := (-Rint);
@@ -5005,7 +5005,7 @@ package body Sem_Eval is
declare
Modulus : constant Uint :=
- (if Is_Modular_Integer_Type (Typ) then Einfo.Entities.Modulus (Typ)
+ (if Has_Modular_Operations (Typ) then Einfo.Entities.Modulus (Typ)
else Uint_2 ** RM_Size (Typ));
Amount : constant Uint := UI_Min (Expr_Value (Right), RM_Size (Typ));
-- Shift by an Amount greater than the size is all-zeros or all-ones.
@@ -5023,7 +5023,7 @@ package body Sem_Eval is
Val := (Expr_Value (Left) * (Uint_2 ** Amount))
rem Modulus;
- if Is_Modular_Integer_Type (Typ)
+ if Has_Modular_Operations (Typ)
or else Val < Modulus / Uint_2
then
Fold_Uint (N, Val, Static => Static);
@@ -5062,10 +5062,10 @@ package body Sem_Eval is
begin
-- X / 2**Y if X if positive or a small enough modular integer
- if (Is_Modular_Integer_Type (Typ)
+ if (Has_Modular_Operations (Typ)
and then Expr_Value (Left) < Modulus / Uint_2)
or else
- (not Is_Modular_Integer_Type (Typ)
+ (not Has_Modular_Operations (Typ)
and then Expr_Value (Left) >= 0)
then
Fold_Uint (N, Expr_Value (Left) / Two_Y, Static => Static);
@@ -5076,7 +5076,7 @@ package body Sem_Eval is
elsif Two_Y > Modulus
or else Expr_Value (Left) = Uint_Minus_1
then
- if Is_Modular_Integer_Type (Typ) then
+ if Has_Modular_Operations (Typ) then
Fold_Uint (N, Modulus - Uint_1, Static => Static);
else
Fold_Uint (N, Uint_Minus_1, Static => Static);
@@ -5085,7 +5085,7 @@ package body Sem_Eval is
-- Large modular integer, compute via multiply/divide the
-- following: X >> Y + (1 << Y - 1) << (RM_Size - Y)
- elsif Is_Modular_Integer_Type (Typ) then
+ elsif Has_Modular_Operations (Typ) then
Fold_Uint
(N,
(Expr_Value (Left)) / Two_Y
@@ -7207,7 +7207,7 @@ package body Sem_Eval is
-- An expression of a formal modular type is not foldable because
-- the modulus is unknown.
- elsif Is_Modular_Integer_Type (Etype (Op1))
+ elsif Has_Modular_Operations (Etype (Op1))
and then Is_Generic_Type (Etype (Op1))
then
Check_Non_Static_Context (Op1);
@@ -7283,7 +7283,7 @@ package body Sem_Eval is
-- Exclude expressions of a generic modular type, as above
- elsif Is_Modular_Integer_Type (Etype (Op1))
+ elsif Has_Modular_Operations (Etype (Op1))
and then Is_Generic_Type (Etype (Op1))
then
Check_Non_Static_Context (Op1);
@@ -7305,7 +7305,7 @@ package body Sem_Eval is
end if;
if not Fold
- and then not Is_Modular_Integer_Type (Etype (N))
+ and then not Has_Modular_Operations (Etype (N))
then
case Nkind (N) is
when N_Op_And =>
@@ -7482,7 +7482,8 @@ package body Sem_Eval is
-- size, then the source value must be in range. We exclude biased
-- types, because they bizarrely can generate out of range values.
- elsif Is_Signed_Integer_Type (Etype (N))
+ elsif (Is_Signed_Integer_Type (Etype (N))
+ and then Is_Signed_Integer_Type (Typ))
and then Is_Known_Valid (Typ)
and then Esize (Etype (N)) <= Esize (Typ)
and then not Has_Biased_Representation (Etype (N))
diff --git a/gcc/ada/sem_intr.adb b/gcc/ada/sem_intr.adb
index 574ce871dd8..9c266ca5864 100644
--- a/gcc/ada/sem_intr.adb
+++ b/gcc/ada/sem_intr.adb
@@ -455,7 +455,7 @@ package body Sem_Intr is
-- For modular type, modulus must be 2**8, 2**16, 2**32, or 2**64.
-- Don't apply to generic types, since we may not have a modulus value.
- elsif Is_Modular_Integer_Type (Typ1)
+ elsif Has_Modular_Operations (Typ1)
and then not Is_Generic_Type (Typ1)
and then Modulus (Typ1) /= Uint_2 ** 8
and then Modulus (Typ1) /= Uint_2 ** 16
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 203c8c7fd3b..0d9f20a714f 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -28172,7 +28172,9 @@ package body Sem_Prag is
return;
elsif not Is_Integer_Type (E)
- or else Is_Modular_Integer_Type (E)
+ or else
+ (Is_Modular_Integer_Type (E)
+ and then not Has_Unsigned_Base_Range_Aspect (Base_Type (E)))
then
Error_Pragma_Arg
("cannot apply pragma %",
@@ -28211,7 +28213,10 @@ package body Sem_Prag is
Set_First_Subtype_Link (Freeze_Node (Base_Type (E)), E);
Set_Has_Delayed_Freeze (E);
- Set_Has_Unsigned_Base_Range_Aspect (Base_Type (E));
+ -- Attribute Has_Unsigned_Base_Range_Aspect must have been
+ -- set by Unsigned_Base_Range_Type_Declaration or inherited
+ -- by Build_Derived_Numeric_Type.
+ pragma Assert (Has_Unsigned_Base_Range_Aspect (Base_Type (E)));
end if;
end Unsigned_Base_Range;
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 6d6765b8d3f..14dd9ade235 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -10118,7 +10118,7 @@ package body Sem_Res is
Set_Etype (N, Any_Type);
return;
- elsif Is_Modular_Integer_Type (Typ)
+ elsif Has_Modular_Operations (Typ)
and then Etype (Left_Opnd (N)) = Universal_Integer
and then Etype (Right_Opnd (N)) = Universal_Integer
then
@@ -12767,7 +12767,7 @@ package body Sem_Res is
and then Nkind (N) = N_Op_Minus
and then Nkind (R) = N_Integer_Literal
and then Comes_From_Source (R)
- and then Is_Modular_Integer_Type (B_Typ)
+ and then Has_Modular_Operations (B_Typ)
and then Nkind (Parent (N)) not in N_Qualified_Expression
| N_Type_Conversion
and then Expr_Value (R) > Uint_1
@@ -13260,7 +13260,7 @@ package body Sem_Res is
if Length = 1 then
High_Bound := New_Copy_Tree (Low_Bound);
- elsif Is_Signed_Integer_Type (Index_Type) then
+ elsif Has_Overflow_Operations (Index_Type) then
High_Bound :=
Make_Op_Add (Loc,
Left_Opnd => New_Copy_Tree (Low_Bound),
diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb
index ceaed45efcf..b6bfa2a80cf 100644
--- a/gcc/ada/sem_type.adb
+++ b/gcc/ada/sem_type.adb
@@ -1144,7 +1144,7 @@ package body Sem_Type is
-- A boolean operation on integer literals is compatible with modular
-- context.
- elsif T2 = Any_Modular and then Is_Modular_Integer_Type (T1) then
+ elsif T2 = Any_Modular and then Has_Modular_Operations (T1) then
return True;
-- The actual type may be the result of a previous error
@@ -3375,7 +3375,7 @@ package body Sem_Type is
or else (T1 = Universal_Real and then Is_Real_Type (T2))
or else (T1 = Universal_Fixed and then Is_Fixed_Point_Type (T2))
or else (T1 = Any_Fixed and then Is_Fixed_Point_Type (T2))
- or else (T1 = Any_Modular and then Is_Modular_Integer_Type (T2))
+ or else (T1 = Any_Modular and then Has_Modular_Operations (T2))
or else (T1 = Any_Character and then Is_Character_Type (T2))
or else (T1 = Any_String and then Is_String_Type (T2))
or else (T1 = Any_Composite and then Is_Aggregate_Type (T2))
@@ -3395,7 +3395,7 @@ package body Sem_Type is
or else (T2 = Universal_Real and then Is_Real_Type (T1))
or else (T2 = Universal_Fixed and then Is_Fixed_Point_Type (T1))
or else (T2 = Any_Fixed and then Is_Fixed_Point_Type (T1))
- or else (T2 = Any_Modular and then Is_Modular_Integer_Type (T1))
+ or else (T2 = Any_Modular and then Has_Modular_Operations (T1))
or else (T2 = Any_Character and then Is_Character_Type (T1))
or else (T2 = Any_String and then Is_String_Type (T1))
or else (T2 = Any_Composite and then Is_Aggregate_Type (T1))
@@ -3562,7 +3562,7 @@ package body Sem_Type is
function Valid_Boolean_Arg (T : Entity_Id) return Boolean is
begin
if Is_Boolean_Type (T)
- or else Is_Modular_Integer_Type (T)
+ or else Has_Modular_Operations (T)
or else T = Universal_Integer
or else T = Any_Composite
or else T = Raise_Type
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index e4dd8dbdd56..843bfb4a54b 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -30738,7 +30738,7 @@ package body Sem_Util is
-- of the same modular type, and (M1 and M2) = 0 was intended.
if Expec_Type = Standard_Boolean
- and then Is_Modular_Integer_Type (Found_Type)
+ and then Has_Modular_Operations (Found_Type)
and then Nkind (Parent (Expr)) in N_Op_And | N_Op_Or | N_Op_Xor
and then Nkind (Right_Opnd (Parent (Expr))) in N_Op_Compare
then
diff --git a/gcc/ada/style.adb b/gcc/ada/style.adb
index 56d1060bd79..e202631eab6 100644
--- a/gcc/ada/style.adb
+++ b/gcc/ada/style.adb
@@ -152,7 +152,7 @@ package body Style is
-- Second OK case, modular types
- elsif Is_Modular_Integer_Type (Etype (Node)) then
+ elsif Has_Modular_Operations (Etype (Node)) then
return;
-- Third OK case, array types
--
2.51.0
