From: Piotr Trojanek Date: Fri, 1 Jan 2021 12:27:44 +0000 (+0100) Subject: [Ada] Reuse Is_Universal_Numeric_Type where possible X-Git-Tag: basepoints/gcc-13~7938 X-Git-Url: http://git.ipfire.org/gitweb.cgi?a=commitdiff_plain;h=785d39acbff14715c307c234f8839e95950be9e0;p=thirdparty%2Fgcc.git [Ada] Reuse Is_Universal_Numeric_Type where possible gcc/ada/ * exp_ch4.adb (Analyze_Number_Declaration, Expand_N_Op_Expon): Simplify with Is_Universal_Numeric_Type. * sem_attr.adb (Resolve_Attribute): Likewise. * sem_ch3.adb: Likewise. * sem_ch4.adb (Check_Common_Type, Check_Arithmetic_Pair): Likewise. * sem_eval.adb (Eval_Unary_Op, Test_In_Range): Likewise. * sem_res.adb (Resolve_Arithmetic_Op, Resolve_Membership_Op, Resolve_Op_Expon, Resolve_Unary_Op, Set_Mixed_Mode_Operand, Set_Operand_Type): Likewise. * sem_type.adb (Disambiguate, Find_Unique_Type): Likewise. * sem_util.adb (Universal_Interpretation): Likewise. --- diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 4121e9f749c1..9d64ef7250df 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -9145,8 +9145,7 @@ package body Exp_Ch4 is -- If we are in the right type, we can call runtime routine directly if Typ = Etyp - and then Rtyp /= Universal_Integer - and then Rtyp /= Universal_Real + and then not Is_Universal_Numeric_Type (Rtyp) then Rewrite (N, Wrap_MA ( diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 51bedb50abf3..6b3027260b79 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -10715,9 +10715,7 @@ package body Sem_Attr is -- If attribute was universal type, reset to actual type - if Etype (N) = Universal_Integer - or else Etype (N) = Universal_Real - then + if Is_Universal_Numeric_Type (Etype (N)) then Set_Etype (N, Typ); end if; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 0b8563a024a1..5a3d206c985d 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -3569,10 +3569,7 @@ package body Sem_Ch3 is if T = Any_Type then T := It.Typ; - elsif It.Typ = Universal_Real - or else - It.Typ = Universal_Integer - then + elsif Is_Universal_Numeric_Type (It.Typ) then -- Choose universal interpretation over any other T := It.Typ; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index ad744a7aae34..85e63e932c8c 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -4348,8 +4348,7 @@ package body Sem_Ch4 is or else Covers (T1 => T2, T2 => T1) then - if T1 = Universal_Integer - or else T1 = Universal_Real + if Is_Universal_Numeric_Type (T1) or else T1 = Any_Character then Add_One_Interp (N, Base_Type (T2), Base_Type (T2)); @@ -5975,7 +5974,7 @@ package body Sem_Ch4 is function Specific_Type (T1, T2 : Entity_Id) return Entity_Id is begin - if T1 = Universal_Integer or else T1 = Universal_Real then + if Is_Universal_Numeric_Type (T1) then return Base_Type (T2); else return Base_Type (T1); diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index b772c9ad5a95..8f3cbf052e98 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -4363,10 +4363,7 @@ package body Sem_Eval is return; end if; - if Etype (Right) = Universal_Integer - or else - Etype (Right) = Universal_Real - then + if Is_Universal_Numeric_Type (Etype (Right)) then Otype := Find_Universal_Operator_Type (N); end if; @@ -7243,7 +7240,7 @@ package body Sem_Eval is -- Universal types have no range limits, so always in range - elsif Typ = Universal_Integer or else Typ = Universal_Real then + elsif Is_Universal_Numeric_Type (Typ) then return In_Range; -- Never known if not scalar type. Don't know if this can actually diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index da50450974bd..47798e3bbccd 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -2344,8 +2344,7 @@ package body Sem_Res is if Ada_Version >= Ada_2005 and then It.Typ = Typ - and then Typ /= Universal_Integer - and then Typ /= Universal_Real + and then not Is_Universal_Numeric_Type (Typ) and then Present (It.Abstract_Op) then if Debug_Flag_V then @@ -5731,14 +5730,12 @@ package body Sem_Res is if not Is_Overloaded (N) then T := Etype (N); return Base_Type (T) = Base_Type (Standard_Integer) - or else T = Universal_Integer - or else T = Universal_Real; + or else Is_Universal_Numeric_Type (T); else Get_First_Interp (N, Index, It); while Present (It.Typ) loop if Base_Type (It.Typ) = Base_Type (Standard_Integer) - or else It.Typ = Universal_Integer - or else It.Typ = Universal_Real + or else Is_Universal_Numeric_Type (It.Typ) then return True; end if; @@ -5773,8 +5770,7 @@ package body Sem_Res is elsif Universal_Interpretation (N) = Universal_Real and then (T = Base_Type (Standard_Integer) - or else T = Universal_Integer - or else T = Universal_Real) + or else Is_Universal_Numeric_Type (T)) then -- A universal real can appear in a fixed-type context. We resolve -- the literal with that context, even though this might raise an @@ -5907,9 +5903,7 @@ package body Sem_Res is procedure Set_Operand_Type (N : Node_Id) is begin - if Etype (N) = Universal_Integer - or else Etype (N) = Universal_Real - then + if Is_Universal_Numeric_Type (Etype (N)) then Set_Etype (N, T); end if; end Set_Operand_Type; @@ -5934,7 +5928,7 @@ package body Sem_Res is -- Set the type of the node to its universal interpretation because -- legality checks on an exponentiation operand need the context. - elsif (B_Typ = Universal_Integer or else B_Typ = Universal_Real) + elsif Is_Universal_Numeric_Type (B_Typ) and then Present (Universal_Interpretation (L)) and then Present (Universal_Interpretation (R)) then @@ -6047,9 +6041,9 @@ package body Sem_Res is end if; else - if (TL = Universal_Integer or else TL = Universal_Real) + if Is_Universal_Numeric_Type (TL) and then - (TR = Universal_Integer or else TR = Universal_Real) + Is_Universal_Numeric_Type (TR) then Check_For_Visible_Operator (N, B_Typ); end if; @@ -9792,10 +9786,7 @@ package body Sem_Res is goto SM_Exit; elsif not Is_Overloaded (R) - and then - (Etype (R) = Universal_Integer - or else - Etype (R) = Universal_Real) + and then Is_Universal_Numeric_Type (Etype (R)) and then Is_Overloaded (L) then T := Etype (R); @@ -10237,9 +10228,7 @@ package body Sem_Res is return; end if; - if Etype (Left_Opnd (N)) = Universal_Integer - or else Etype (Left_Opnd (N)) = Universal_Real - then + if Is_Universal_Numeric_Type (Etype (Left_Opnd (N))) then Check_For_Visible_Operator (N, B_Typ); end if; @@ -12081,10 +12070,7 @@ package body Sem_Res is -- Deal with universal cases - if Etype (R) = Universal_Integer - or else - Etype (R) = Universal_Real - then + if Is_Universal_Numeric_Type (Etype (R)) then Check_For_Visible_Operator (N, B_Typ); end if; diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index 933ffbf3034a..b22c904601d7 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -1853,8 +1853,7 @@ package body Sem_Type is begin Get_First_Interp (N, I, It); while Present (It.Typ) loop - if (It.Typ = Universal_Integer - or else It.Typ = Universal_Real) + if Is_Universal_Numeric_Type (It.Typ) and then (Typ = Any_Type or else Covers (Typ, It.Typ)) then return It; @@ -2284,7 +2283,7 @@ package body Sem_Type is -- apply preference rule. if TR /= Any_Type then - if (T = Universal_Integer or else T = Universal_Real) + if Is_Universal_Numeric_Type (T) and then It.Typ = T then TR := It.Typ; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index d6a840f6a637..343ae705fb04 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -29189,9 +29189,7 @@ package body Sem_Util is if Nkind (Opnd) = N_Defining_Identifier or else not Is_Overloaded (Opnd) then - if Etype (Opnd) = Universal_Integer - or else Etype (Opnd) = Universal_Real - then + if Is_Universal_Numeric_Type (Etype (Opnd)) then return Etype (Opnd); else return Empty; @@ -29200,9 +29198,7 @@ package body Sem_Util is else Get_First_Interp (Opnd, Index, It); while Present (It.Typ) loop - if It.Typ = Universal_Integer - or else It.Typ = Universal_Real - then + if Is_Universal_Numeric_Type (It.Typ) then return It.Typ; end if;