aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPiotr Trojanek <trojanek@adacore.com>2021-01-01 13:27:44 +0100
committerPierre-Marie de Rodat <derodat@adacore.com>2021-05-03 05:28:29 -0400
commit785d39acbff14715c307c234f8839e95950be9e0 (patch)
treeb907fb19af9d6a13f7e78d0959c6e95df9441959
parentbcc150393e16baa1a1ce37b64e2fc5e1f7a38fc3 (diff)
downloadgcc-785d39acbff14715c307c234f8839e95950be9e0.zip
gcc-785d39acbff14715c307c234f8839e95950be9e0.tar.gz
gcc-785d39acbff14715c307c234f8839e95950be9e0.tar.bz2
[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.
-rw-r--r--gcc/ada/exp_ch4.adb3
-rw-r--r--gcc/ada/sem_attr.adb4
-rw-r--r--gcc/ada/sem_ch3.adb5
-rw-r--r--gcc/ada/sem_ch4.adb5
-rw-r--r--gcc/ada/sem_eval.adb7
-rw-r--r--gcc/ada/sem_res.adb36
-rw-r--r--gcc/ada/sem_type.adb5
-rw-r--r--gcc/ada/sem_util.adb8
8 files changed, 22 insertions, 51 deletions
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 4121e9f..9d64ef7 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 51bedb5..6b30272 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 0b8563a..5a3d206 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 ad744a7..85e63e9 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 b772c9a..8f3cbf0 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 da50450..47798e3 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 933ffbf..b22c904 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 d6a840f..343ae70 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;