From: Javier Miranda Date: Tue, 18 Nov 2025 19:53:58 +0000 (+0000) Subject: ada: Unsigned_Base_Range aspect (part 6) X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=a99a56a09190ff2a8bb26588e1379077dc0ae9e1;p=thirdparty%2Fgcc.git ada: Unsigned_Base_Range aspect (part 6) 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. --- 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