public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc(refs/users/guojiufu/heads/personal-branch)] [Ada] Rename parameter of routines in Checks
@ 2020-06-10 3:39 Jiu Fu Guo
0 siblings, 0 replies; only message in thread
From: Jiu Fu Guo @ 2020-06-10 3:39 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:6c8e70fe86da1b52160aa380f30cbb1bf644c407
commit 6c8e70fe86da1b52160aa380f30cbb1bf644c407
Author: Eric Botcazou <ebotcazou@adacore.com>
Date: Thu Jan 30 13:23:31 2020 +0100
[Ada] Rename parameter of routines in Checks
2020-06-05 Eric Botcazou <ebotcazou@adacore.com>
gcc/ada/
* checks.ads (Apply_Length_Check): Rename Ck_Node parameter to
Expr.
(Apply_Range_Check): Likewise.
(Get_Range_Checks): Likewise.
* checks.adb (Apply_Float_Conversion_Check): Likewise.
(Apply_Selected_Length_Checks): Likewise.
(Apply_Selected_Range_Checks): Likewise.
(Guard_Access): Likewise.
(Selected_Length_Checks): Likewise. Also avoid shadowing in
child procedures.
(Selected_Range_Checks): Likewise.
Diff:
---
gcc/ada/checks.adb | 258 ++++++++++++++++++++++++++---------------------------
gcc/ada/checks.ads | 12 +--
2 files changed, 132 insertions(+), 138 deletions(-)
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 1b8e2dfdb74..bd9c6adab81 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -223,7 +223,7 @@ package body Checks is
-- can be referenced and trusted only if ROK is set True.
procedure Apply_Float_Conversion_Check
- (Ck_Node : Node_Id;
+ (Expr : Node_Id;
Target_Typ : Entity_Id);
-- The checks on a conversion from a floating-point type to an integer
-- type are delicate. They have to be performed before conversion, they
@@ -231,7 +231,7 @@ package body Checks is
-- be taken into account to determine the safe bounds of the operand.
procedure Apply_Selected_Length_Checks
- (Ck_Node : Node_Id;
+ (Expr : Node_Id;
Target_Typ : Entity_Id;
Source_Typ : Entity_Id;
Do_Static : Boolean);
@@ -241,7 +241,7 @@ package body Checks is
-- only a static check is to be done.
procedure Apply_Selected_Range_Checks
- (Ck_Node : Node_Id;
+ (Expr : Node_Id;
Target_Typ : Entity_Id;
Source_Typ : Entity_Id;
Do_Static : Boolean);
@@ -307,9 +307,9 @@ package body Checks is
-- To be cleaned up???
function Guard_Access
- (Cond : Node_Id;
- Loc : Source_Ptr;
- Ck_Node : Node_Id) return Node_Id;
+ (Cond : Node_Id;
+ Loc : Source_Ptr;
+ Expr : Node_Id) return Node_Id;
-- In the access type case, guard the test with a test to ensure
-- that the access value is non-null, since the checks do not
-- not apply to null access values.
@@ -332,7 +332,7 @@ package body Checks is
-- of an entity, if these checks are suppressed for the entity.
function Selected_Length_Checks
- (Ck_Node : Node_Id;
+ (Expr : Node_Id;
Target_Typ : Entity_Id;
Source_Typ : Entity_Id;
Warn_Node : Node_Id) return Check_Result;
@@ -345,7 +345,7 @@ package body Checks is
-- Selected_Range_Checks.
function Selected_Range_Checks
- (Ck_Node : Node_Id;
+ (Expr : Node_Id;
Target_Typ : Entity_Id;
Source_Typ : Entity_Id;
Warn_Node : Node_Id) return Check_Result;
@@ -1999,17 +1999,17 @@ package body Checks is
-- Hi_OK be True.
procedure Apply_Float_Conversion_Check
- (Ck_Node : Node_Id;
+ (Expr : Node_Id;
Target_Typ : Entity_Id)
is
LB : constant Node_Id := Type_Low_Bound (Target_Typ);
HB : constant Node_Id := Type_High_Bound (Target_Typ);
- Loc : constant Source_Ptr := Sloc (Ck_Node);
- Expr_Type : constant Entity_Id := Base_Type (Etype (Ck_Node));
+ Loc : constant Source_Ptr := Sloc (Expr);
+ Expr_Type : constant Entity_Id := Base_Type (Etype (Expr));
Target_Base : constant Entity_Id :=
Implementation_Base_Type (Target_Typ);
- Par : constant Node_Id := Parent (Ck_Node);
+ Par : constant Node_Id := Parent (Expr);
pragma Assert (Nkind (Par) = N_Type_Conversion);
-- Parent of check node, must be a type conversion
@@ -2049,7 +2049,7 @@ package body Checks is
-- set the Do_Range check flag, since the range check is taken care of
-- by the code we will generate.
- Set_Do_Range_Check (Ck_Node, False);
+ Set_Do_Range_Check (Expr, False);
if not Compile_Time_Known_Value (LB)
or not Compile_Time_Known_Value (HB)
@@ -2064,7 +2064,7 @@ package body Checks is
Temp : constant Entity_Id := Make_Temporary (Loc, 'T', Par);
begin
- Apply_Float_Conversion_Check (Ck_Node, Target_Base);
+ Apply_Float_Conversion_Check (Expr, Target_Base);
Set_Etype (Temp, Target_Base);
-- Note: Previously the declaration was inserted above the parent
@@ -2105,21 +2105,21 @@ package body Checks is
-- we can do the comparison with the bounds and the conversion to
-- an integer type statically. The range checks are unchanged.
- if Nkind (Ck_Node) = N_Real_Literal
- and then Etype (Ck_Node) = Universal_Real
+ if Nkind (Expr) = N_Real_Literal
+ and then Etype (Expr) = Universal_Real
and then Is_Integer_Type (Target_Typ)
then
declare
- Int_Val : constant Uint := UR_To_Uint (Realval (Ck_Node));
+ Int_Val : constant Uint := UR_To_Uint (Realval (Expr));
begin
if Int_Val <= Ilast and then Int_Val >= Ifirst then
-- Conversion is safe
- Rewrite (Parent (Ck_Node),
+ Rewrite (Parent (Expr),
Make_Integer_Literal (Loc, UI_To_Int (Int_Val)));
- Analyze_And_Resolve (Parent (Ck_Node), Target_Typ);
+ Analyze_And_Resolve (Parent (Expr), Target_Typ);
return;
end if;
end;
@@ -2140,7 +2140,7 @@ package body Checks is
Lo_OK := (Ifirst > 0);
else
- Lo := Machine (Expr_Type, UR_From_Uint (Ifirst), Round_Even, Ck_Node);
+ Lo := Machine (Expr_Type, UR_From_Uint (Ifirst), Round_Even, Expr);
Lo_OK := (Lo >= UR_From_Uint (Ifirst));
end if;
@@ -2149,14 +2149,14 @@ package body Checks is
-- Lo_Chk := (X >= Lo)
Lo_Chk := Make_Op_Ge (Loc,
- Left_Opnd => Duplicate_Subexpr_No_Checks (Ck_Node),
+ Left_Opnd => Duplicate_Subexpr_No_Checks (Expr),
Right_Opnd => Make_Real_Literal (Loc, Lo));
else
-- Lo_Chk := (X > Lo)
Lo_Chk := Make_Op_Gt (Loc,
- Left_Opnd => Duplicate_Subexpr_No_Checks (Ck_Node),
+ Left_Opnd => Duplicate_Subexpr_No_Checks (Expr),
Right_Opnd => Make_Real_Literal (Loc, Lo));
end if;
@@ -2174,7 +2174,7 @@ package body Checks is
Hi := UR_From_Uint (Ilast) + Ureal_Half;
Hi_OK := (Ilast < 0);
else
- Hi := Machine (Expr_Type, UR_From_Uint (Ilast), Round_Even, Ck_Node);
+ Hi := Machine (Expr_Type, UR_From_Uint (Ilast), Round_Even, Expr);
Hi_OK := (Hi <= UR_From_Uint (Ilast));
end if;
@@ -2183,14 +2183,14 @@ package body Checks is
-- Hi_Chk := (X <= Hi)
Hi_Chk := Make_Op_Le (Loc,
- Left_Opnd => Duplicate_Subexpr_No_Checks (Ck_Node),
+ Left_Opnd => Duplicate_Subexpr_No_Checks (Expr),
Right_Opnd => Make_Real_Literal (Loc, Hi));
else
-- Hi_Chk := (X < Hi)
Hi_Chk := Make_Op_Lt (Loc,
- Left_Opnd => Duplicate_Subexpr_No_Checks (Ck_Node),
+ Left_Opnd => Duplicate_Subexpr_No_Checks (Expr),
Right_Opnd => Make_Real_Literal (Loc, Hi));
end if;
@@ -2208,7 +2208,7 @@ package body Checks is
-- Raise CE if either conditions does not hold
- Insert_Action (Ck_Node,
+ Insert_Action (Expr,
Make_Raise_Constraint_Error (Loc,
Condition => Make_Op_Not (Loc, Make_And_Then (Loc, Lo_Chk, Hi_Chk)),
Reason => Reason));
@@ -2219,13 +2219,13 @@ package body Checks is
------------------------
procedure Apply_Length_Check
- (Ck_Node : Node_Id;
+ (Expr : Node_Id;
Target_Typ : Entity_Id;
Source_Typ : Entity_Id := Empty)
is
begin
Apply_Selected_Length_Checks
- (Ck_Node, Target_Typ, Source_Typ, Do_Static => False);
+ (Expr, Target_Typ, Source_Typ, Do_Static => False);
end Apply_Length_Check;
-------------------------------------
@@ -2853,13 +2853,13 @@ package body Checks is
-----------------------
procedure Apply_Range_Check
- (Ck_Node : Node_Id;
+ (Expr : Node_Id;
Target_Typ : Entity_Id;
Source_Typ : Entity_Id := Empty)
is
begin
Apply_Selected_Range_Checks
- (Ck_Node, Target_Typ, Source_Typ, Do_Static => False);
+ (Expr, Target_Typ, Source_Typ, Do_Static => False);
end Apply_Range_Check;
------------------------------
@@ -3263,7 +3263,7 @@ package body Checks is
----------------------------------
procedure Apply_Selected_Length_Checks
- (Ck_Node : Node_Id;
+ (Expr : Node_Id;
Target_Typ : Entity_Id;
Source_Typ : Entity_Id;
Do_Static : Boolean)
@@ -3273,7 +3273,7 @@ package body Checks is
or else
not Length_Checks_Suppressed (Target_Typ);
- Loc : constant Source_Ptr := Sloc (Ck_Node);
+ Loc : constant Source_Ptr := Sloc (Expr);
Cond : Node_Id;
R_Cno : Node_Id;
@@ -3290,7 +3290,7 @@ package body Checks is
end if;
R_Result :=
- Selected_Length_Checks (Ck_Node, Target_Typ, Source_Typ, Empty);
+ Selected_Length_Checks (Expr, Target_Typ, Source_Typ, Empty);
for J in 1 .. 2 loop
R_Cno := R_Result (J);
@@ -3304,13 +3304,13 @@ package body Checks is
if Ekind (Current_Scope) = E_Package
and then Is_Compilation_Unit (Current_Scope)
then
- Ensure_Defined (Target_Typ, Ck_Node);
+ Ensure_Defined (Target_Typ, Expr);
if Present (Source_Typ) then
- Ensure_Defined (Source_Typ, Ck_Node);
+ Ensure_Defined (Source_Typ, Expr);
- elsif Is_Itype (Etype (Ck_Node)) then
- Ensure_Defined (Etype (Ck_Node), Ck_Node);
+ elsif Is_Itype (Etype (Expr)) then
+ Ensure_Defined (Etype (Expr), Expr);
end if;
end if;
@@ -3324,15 +3324,15 @@ package body Checks is
-- Case where node does not now have a dynamic check
- if not Has_Dynamic_Length_Check (Ck_Node) then
+ if not Has_Dynamic_Length_Check (Expr) then
-- If checks are on, just insert the check
if Checks_On then
- Insert_Action (Ck_Node, R_Cno);
+ Insert_Action (Expr, R_Cno);
if not Do_Static then
- Set_Has_Dynamic_Length_Check (Ck_Node);
+ Set_Has_Dynamic_Length_Check (Expr);
end if;
-- If checks are off, then analyze the length check after
@@ -3341,7 +3341,7 @@ package body Checks is
-- compile time warning in this case.
else
- Set_Parent (R_Cno, Ck_Node);
+ Set_Parent (R_Cno, Expr);
Analyze (R_Cno);
end if;
end if;
@@ -3352,7 +3352,7 @@ package body Checks is
and then Entity (Cond) = Standard_True
then
Apply_Compile_Time_Constraint_Error
- (Ck_Node, "wrong length for array of}??",
+ (Expr, "wrong length for array of}??",
CE_Length_Check_Failed,
Ent => Target_Typ,
Typ => Target_Typ);
@@ -3377,7 +3377,7 @@ package body Checks is
---------------------------------
procedure Apply_Selected_Range_Checks
- (Ck_Node : Node_Id;
+ (Expr : Node_Id;
Target_Typ : Entity_Id;
Source_Typ : Entity_Id;
Do_Static : Boolean)
@@ -3387,7 +3387,7 @@ package body Checks is
or else
not Range_Checks_Suppressed (Target_Typ);
- Loc : constant Source_Ptr := Sloc (Ck_Node);
+ Loc : constant Source_Ptr := Sloc (Expr);
Cond : Node_Id;
R_Cno : Node_Id;
@@ -3406,7 +3406,7 @@ package body Checks is
end if;
R_Result :=
- Selected_Range_Checks (Ck_Node, Target_Typ, Source_Typ, Empty);
+ Selected_Range_Checks (Expr, Target_Typ, Source_Typ, Empty);
if GNATprove_Mode then
return;
@@ -3428,14 +3428,14 @@ package body Checks is
-- Insert the range check before the related context. Note that
-- this action analyses the triggering condition.
- Insert_Action (Ck_Node, R_Cno);
+ Insert_Action (Expr, R_Cno);
-- This old code doesn't make sense, why is the context flagged as
-- requiring dynamic range checks now in the middle of generating
-- them ???
if not Do_Static then
- Set_Has_Dynamic_Range_Check (Ck_Node);
+ Set_Has_Dynamic_Range_Check (Expr);
end if;
-- The triggering condition evaluates to True, the range check
@@ -3449,19 +3449,19 @@ package body Checks is
-- N_Range. The warning message will point to the lower bound
-- and complain about a range, which seems OK.
- if Nkind (Ck_Node) = N_Range then
+ if Nkind (Expr) = N_Range then
Apply_Compile_Time_Constraint_Error
- (Low_Bound (Ck_Node),
+ (Low_Bound (Expr),
"static range out of bounds of}??",
CE_Range_Check_Failed,
Ent => Target_Typ,
Typ => Target_Typ);
- Set_Raises_Constraint_Error (Ck_Node);
+ Set_Raises_Constraint_Error (Expr);
else
Apply_Compile_Time_Constraint_Error
- (Ck_Node,
+ (Expr,
"static value out of range of}??",
CE_Range_Check_Failed,
Ent => Target_Typ,
@@ -7358,14 +7358,14 @@ package body Checks is
----------------------
function Get_Range_Checks
- (Ck_Node : Node_Id;
+ (Expr : Node_Id;
Target_Typ : Entity_Id;
Source_Typ : Entity_Id := Empty;
Warn_Node : Node_Id := Empty) return Check_Result
is
begin
return
- Selected_Range_Checks (Ck_Node, Target_Typ, Source_Typ, Warn_Node);
+ Selected_Range_Checks (Expr, Target_Typ, Source_Typ, Warn_Node);
end Get_Range_Checks;
------------------
@@ -7373,16 +7373,16 @@ package body Checks is
------------------
function Guard_Access
- (Cond : Node_Id;
- Loc : Source_Ptr;
- Ck_Node : Node_Id) return Node_Id
+ (Cond : Node_Id;
+ Loc : Source_Ptr;
+ Expr : Node_Id) return Node_Id
is
begin
if Nkind (Cond) = N_Or_Else then
Set_Paren_Count (Cond, 1);
end if;
- if Nkind (Ck_Node) = N_Allocator then
+ if Nkind (Expr) = N_Allocator then
return Cond;
else
@@ -7390,7 +7390,7 @@ package body Checks is
Make_And_Then (Loc,
Left_Opnd =>
Make_Op_Ne (Loc,
- Left_Opnd => Duplicate_Subexpr_No_Checks (Ck_Node),
+ Left_Opnd => Duplicate_Subexpr_No_Checks (Expr),
Right_Opnd => Make_Null (Loc)),
Right_Opnd => Cond);
end if;
@@ -9555,12 +9555,12 @@ package body Checks is
----------------------------
function Selected_Length_Checks
- (Ck_Node : Node_Id;
+ (Expr : Node_Id;
Target_Typ : Entity_Id;
Source_Typ : Entity_Id;
Warn_Node : Node_Id) return Check_Result
is
- Loc : constant Source_Ptr := Sloc (Ck_Node);
+ Loc : constant Source_Ptr := Sloc (Expr);
S_Typ : Entity_Id;
T_Typ : Entity_Id;
Expr_Actual : Node_Id;
@@ -9592,11 +9592,11 @@ package body Checks is
-- Typ'Length /= Exptyp'Length
function Length_N_Cond
- (Expr : Node_Id;
+ (Exp : Node_Id;
Typ : Entity_Id;
Indx : Nat) return Node_Id;
-- Returns expression to compute:
- -- Typ'Length /= Expr'Length
+ -- Typ'Length /= Exp'Length
function Length_Mismatch_Info_Message
(Left_Element_Count : Uint;
@@ -9641,7 +9641,7 @@ package body Checks is
N := Build_Discriminal_Subtype_Of_Component (E);
if Present (N) then
- Insert_Action (Ck_Node, N);
+ Insert_Action (Expr, N);
E1 := Defining_Identifier (N);
end if;
end if;
@@ -9780,7 +9780,7 @@ package body Checks is
-------------------
function Length_N_Cond
- (Expr : Node_Id;
+ (Exp : Node_Id;
Typ : Entity_Id;
Indx : Nat) return Node_Id
is
@@ -9788,7 +9788,7 @@ package body Checks is
return
Make_Op_Ne (Loc,
Left_Opnd => Get_E_Length (Typ, Indx),
- Right_Opnd => Get_N_Length (Expr, Indx));
+ Right_Opnd => Get_N_Length (Exp, Indx));
end Length_N_Cond;
----------------------------------
@@ -9868,19 +9868,19 @@ package body Checks is
if Target_Typ = Any_Type
or else Target_Typ = Any_Composite
- or else Raises_Constraint_Error (Ck_Node)
+ or else Raises_Constraint_Error (Expr)
then
return Ret_Result;
end if;
if No (Wnode) then
- Wnode := Ck_Node;
+ Wnode := Expr;
end if;
T_Typ := Target_Typ;
if No (Source_Typ) then
- S_Typ := Etype (Ck_Node);
+ S_Typ := Etype (Expr);
else
S_Typ := Source_Typ;
end if;
@@ -9896,7 +9896,7 @@ package body Checks is
-- A simple optimization for the null case
- if Known_Null (Ck_Node) then
+ if Known_Null (Expr) then
return Ret_Result;
end if;
end if;
@@ -9909,10 +9909,10 @@ package body Checks is
-- freeze node does not appear within the generated if expression,
-- but ahead of it.
- Freeze_Before (Ck_Node, T_Typ);
+ Freeze_Before (Expr, T_Typ);
- Expr_Actual := Get_Referenced_Object (Ck_Node);
- Exptyp := Get_Actual_Subtype (Ck_Node);
+ Expr_Actual := Get_Referenced_Object (Expr);
+ Exptyp := Get_Actual_Subtype (Expr);
if Is_Access_Type (Exptyp) then
Exptyp := Designated_Type (Exptyp);
@@ -9972,9 +9972,9 @@ package body Checks is
not In_Package_Body (Cunit_Entity (Current_Sem_Unit))
and then In_Open_Scopes (Scope (Exptyp))
then
- Ref_Node := Make_Itype_Reference (Sloc (Ck_Node));
+ Ref_Node := Make_Itype_Reference (Sloc (Expr));
Set_Itype (Ref_Node, Exptyp);
- Insert_Action (Ck_Node, Ref_Node);
+ Insert_Action (Expr, Ref_Node);
end if;
L_Index := First_Index (T_Typ);
@@ -10058,7 +10058,7 @@ package body Checks is
-- the length or range from the expression itself, making sure we
-- do not evaluate it more than once.
- -- Here Ck_Node is the original expression, or more properly the
+ -- Here Expr is the original expression, or more properly the
-- result of applying Duplicate_Expr to the original tree, forcing
-- the result to be a name.
@@ -10071,7 +10071,7 @@ package body Checks is
for Indx in 1 .. Ndims loop
Evolve_Or_Else
- (Cond, Length_N_Cond (Ck_Node, T_Typ, Indx));
+ (Cond, Length_N_Cond (Expr, T_Typ, Indx));
end loop;
end;
end if;
@@ -10082,7 +10082,7 @@ package body Checks is
if Present (Cond) then
if Do_Access then
- Cond := Guard_Access (Cond, Loc, Ck_Node);
+ Cond := Guard_Access (Cond, Loc, Expr);
end if;
Add_Check
@@ -10099,12 +10099,12 @@ package body Checks is
---------------------------
function Selected_Range_Checks
- (Ck_Node : Node_Id;
+ (Expr : Node_Id;
Target_Typ : Entity_Id;
Source_Typ : Entity_Id;
Warn_Node : Node_Id) return Check_Result
is
- Loc : constant Source_Ptr := Sloc (Ck_Node);
+ Loc : constant Source_Ptr := Sloc (Expr);
S_Typ : Entity_Id;
T_Typ : Entity_Id;
Expr_Actual : Node_Id;
@@ -10119,20 +10119,20 @@ package body Checks is
-- Adds the action given to Ret_Result if N is non-Empty
function Discrete_Range_Cond
- (Expr : Node_Id;
- Typ : Entity_Id) return Node_Id;
+ (Exp : Node_Id;
+ Typ : Entity_Id) return Node_Id;
-- Returns expression to compute:
- -- Low_Bound (Expr) < Typ'First
+ -- Low_Bound (Exp) < Typ'First
-- or else
- -- High_Bound (Expr) > Typ'Last
+ -- High_Bound (Exp) > Typ'Last
function Discrete_Expr_Cond
- (Expr : Node_Id;
- Typ : Entity_Id) return Node_Id;
+ (Exp : Node_Id;
+ Typ : Entity_Id) return Node_Id;
-- Returns expression to compute:
- -- Expr < Typ'First
+ -- Exp < Typ'First
-- or else
- -- Expr > Typ'Last
+ -- Exp > Typ'Last
function Get_E_First_Or_Last
(Loc : Source_Ptr;
@@ -10169,11 +10169,11 @@ package body Checks is
-- Exptyp'First /= Typ'First or else Exptyp'Last /= Typ'Last
function Range_N_Cond
- (Expr : Node_Id;
+ (Exp : Node_Id;
Typ : Entity_Id;
Indx : Nat) return Node_Id;
-- Return expression to compute:
- -- Expr'First < Typ'First or else Expr'Last > Typ'Last
+ -- Exp'First < Typ'First or else Exp'Last > Typ'Last
---------------
-- Add_Check --
@@ -10200,8 +10200,8 @@ package body Checks is
-------------------------
function Discrete_Expr_Cond
- (Expr : Node_Id;
- Typ : Entity_Id) return Node_Id
+ (Exp : Node_Id;
+ Typ : Entity_Id) return Node_Id
is
begin
return
@@ -10210,7 +10210,7 @@ package body Checks is
Make_Op_Lt (Loc,
Left_Opnd =>
Convert_To (Base_Type (Typ),
- Duplicate_Subexpr_No_Checks (Expr)),
+ Duplicate_Subexpr_No_Checks (Exp)),
Right_Opnd =>
Convert_To (Base_Type (Typ),
Get_E_First_Or_Last (Loc, Typ, 0, Name_First))),
@@ -10219,7 +10219,7 @@ package body Checks is
Make_Op_Gt (Loc,
Left_Opnd =>
Convert_To (Base_Type (Typ),
- Duplicate_Subexpr_No_Checks (Expr)),
+ Duplicate_Subexpr_No_Checks (Exp)),
Right_Opnd =>
Convert_To
(Base_Type (Typ),
@@ -10231,11 +10231,11 @@ package body Checks is
-------------------------
function Discrete_Range_Cond
- (Expr : Node_Id;
- Typ : Entity_Id) return Node_Id
+ (Exp : Node_Id;
+ Typ : Entity_Id) return Node_Id
is
- LB : Node_Id := Low_Bound (Expr);
- HB : Node_Id := High_Bound (Expr);
+ LB : Node_Id := Low_Bound (Exp);
+ HB : Node_Id := High_Bound (Exp);
Left_Opnd : Node_Id;
Right_Opnd : Node_Id;
@@ -10391,7 +10391,7 @@ package body Checks is
------------------
function Range_N_Cond
- (Expr : Node_Id;
+ (Exp : Node_Id;
Typ : Entity_Id;
Indx : Nat) return Node_Id
is
@@ -10401,14 +10401,14 @@ package body Checks is
Left_Opnd =>
Make_Op_Lt (Loc,
Left_Opnd =>
- Get_N_First (Expr, Indx),
+ Get_N_First (Exp, Indx),
Right_Opnd =>
Get_E_First_Or_Last (Loc, Typ, Indx, Name_First)),
Right_Opnd =>
Make_Op_Gt (Loc,
Left_Opnd =>
- Get_N_Last (Expr, Indx),
+ Get_N_Last (Exp, Indx),
Right_Opnd =>
Get_E_First_Or_Last (Loc, Typ, Indx, Name_Last)));
end Range_N_Cond;
@@ -10427,19 +10427,19 @@ package body Checks is
if Target_Typ = Any_Type
or else Target_Typ = Any_Composite
- or else Raises_Constraint_Error (Ck_Node)
+ or else Raises_Constraint_Error (Expr)
then
return Ret_Result;
end if;
if No (Wnode) then
- Wnode := Ck_Node;
+ Wnode := Expr;
end if;
T_Typ := Target_Typ;
if No (Source_Typ) then
- S_Typ := Etype (Ck_Node);
+ S_Typ := Etype (Expr);
else
S_Typ := Source_Typ;
end if;
@@ -10449,7 +10449,7 @@ package body Checks is
end if;
-- The order of evaluating T_Typ before S_Typ seems to be critical
- -- because S_Typ can be derived from Etype (Ck_Node), if it's not passed
+ -- because S_Typ can be derived from Etype (Expr), if it's not passed
-- in, and since Node can be an N_Range node, it might be invalid.
-- Should there be an assert check somewhere for taking the Etype of
-- an N_Range node ???
@@ -10461,7 +10461,7 @@ package body Checks is
-- A simple optimization for the null case
- if Known_Null (Ck_Node) then
+ if Known_Null (Expr) then
return Ret_Result;
end if;
end if;
@@ -10469,11 +10469,11 @@ package body Checks is
-- For an N_Range Node, check for a null range and then if not
-- null generate a range check action.
- if Nkind (Ck_Node) = N_Range then
+ if Nkind (Expr) = N_Range then
-- There's no point in checking a range against itself
- if Ck_Node = Scalar_Range (T_Typ) then
+ if Expr = Scalar_Range (T_Typ) then
return Ret_Result;
end if;
@@ -10483,8 +10483,8 @@ package body Checks is
Known_T_LB : constant Boolean := Compile_Time_Known_Value (T_LB);
Known_T_HB : constant Boolean := Compile_Time_Known_Value (T_HB);
- LB : Node_Id := Low_Bound (Ck_Node);
- HB : Node_Id := High_Bound (Ck_Node);
+ LB : Node_Id := Low_Bound (Expr);
+ HB : Node_Id := High_Bound (Expr);
Known_LB : Boolean := False;
Known_HB : Boolean := False;
@@ -10568,7 +10568,7 @@ package body Checks is
if No (Warn_Node) then
Add_Check
(Compile_Time_Constraint_Error
- (Low_Bound (Ck_Node),
+ (Low_Bound (Expr),
"static value out of range of}??", T_Typ));
else
@@ -10583,7 +10583,7 @@ package body Checks is
if No (Warn_Node) then
Add_Check
(Compile_Time_Constraint_Error
- (High_Bound (Ck_Node),
+ (High_Bound (Expr),
"static value out of range of}??", T_Typ));
else
@@ -10597,8 +10597,8 @@ package body Checks is
else
declare
- LB : Node_Id := Low_Bound (Ck_Node);
- HB : Node_Id := High_Bound (Ck_Node);
+ LB : Node_Id := Low_Bound (Expr);
+ HB : Node_Id := High_Bound (Expr);
begin
-- If either bound is a discriminant and we are within the
@@ -10641,7 +10641,7 @@ package body Checks is
end if;
end if;
- Cond := Discrete_Range_Cond (Ck_Node, T_Typ);
+ Cond := Discrete_Range_Cond (Expr, T_Typ);
Set_Paren_Count (Cond, 1);
Cond :=
@@ -10668,7 +10668,7 @@ package body Checks is
-- arbitrary target type, so we do that here.
if Ekind (Base_Type (S_Typ)) /= Ekind (Base_Type (T_Typ)) then
- Cond := Discrete_Expr_Cond (Ck_Node, T_Typ);
+ Cond := Discrete_Expr_Cond (Expr, T_Typ);
-- For literals, we can tell if the constraint error will be
-- raised at compile time, so we never need a dynamic check, but
@@ -10676,7 +10676,7 @@ package body Checks is
-- and replace the literal with a raise constraint error
-- expression. As usual, skip this for access types
- elsif Compile_Time_Known_Value (Ck_Node) and then not Do_Access then
+ elsif Compile_Time_Known_Value (Expr) and then not Do_Access then
declare
LB : constant Node_Id := Type_Low_Bound (T_Typ);
UB : constant Node_Id := Type_High_Bound (T_Typ);
@@ -10692,17 +10692,17 @@ package body Checks is
if Static_Bounds then
if Is_Floating_Point_Type (S_Typ) then
Out_Of_Range :=
- (Expr_Value_R (Ck_Node) < Expr_Value_R (LB))
+ (Expr_Value_R (Expr) < Expr_Value_R (LB))
or else
- (Expr_Value_R (Ck_Node) > Expr_Value_R (UB));
+ (Expr_Value_R (Expr) > Expr_Value_R (UB));
-- Fixed or discrete type
else
Out_Of_Range :=
- Expr_Value (Ck_Node) < Expr_Value (LB)
+ Expr_Value (Expr) < Expr_Value (LB)
or else
- Expr_Value (Ck_Node) > Expr_Value (UB);
+ Expr_Value (Expr) > Expr_Value (UB);
end if;
-- Bounds of the type are static and the literal is out of
@@ -10712,7 +10712,7 @@ package body Checks is
if No (Warn_Node) then
Add_Check
(Compile_Time_Constraint_Error
- (Ck_Node,
+ (Expr,
"static value out of range of}??", T_Typ));
else
@@ -10724,7 +10724,7 @@ package body Checks is
end if;
else
- Cond := Discrete_Expr_Cond (Ck_Node, T_Typ);
+ Cond := Discrete_Expr_Cond (Expr, T_Typ);
end if;
end;
@@ -10734,7 +10734,7 @@ package body Checks is
else
if not In_Subrange_Of (S_Typ, T_Typ) then
- Cond := Discrete_Expr_Cond (Ck_Node, T_Typ);
+ Cond := Discrete_Expr_Cond (Expr, T_Typ);
end if;
end if;
end if;
@@ -10742,7 +10742,7 @@ package body Checks is
if Is_Array_Type (T_Typ) and then Is_Array_Type (S_Typ) then
if Is_Constrained (T_Typ) then
- Expr_Actual := Get_Referenced_Object (Ck_Node);
+ Expr_Actual := Get_Referenced_Object (Expr);
Exptyp := Get_Actual_Subtype (Expr_Actual);
if Is_Access_Type (Exptyp) then
@@ -10817,7 +10817,7 @@ package body Checks is
-- the length or range from the expression itself, making sure we
-- do not evaluate it more than once.
- -- Here Ck_Node is the original expression, or more properly the
+ -- Here Expr is the original expression, or more properly the
-- result of applying Duplicate_Expr to the original tree,
-- forcing the result to be a name.
@@ -10830,7 +10830,7 @@ package body Checks is
for Indx in 1 .. Ndims loop
Evolve_Or_Else
- (Cond, Range_N_Cond (Ck_Node, T_Typ, Indx));
+ (Cond, Range_N_Cond (Expr, T_Typ, Indx));
end loop;
end;
end if;
@@ -10843,7 +10843,7 @@ package body Checks is
-- array type, as 4.6(24.15/2) requires the designated subtypes
-- of the two access types to statically match.
- if Nkind (Parent (Ck_Node)) = N_Type_Conversion
+ if Nkind (Parent (Expr)) = N_Type_Conversion
and then not Do_Access
then
declare
@@ -10852,7 +10852,7 @@ package body Checks is
Opnd_Range : Node_Id;
begin
- Opnd_Index := First_Index (Get_Actual_Subtype (Ck_Node));
+ Opnd_Index := First_Index (Get_Actual_Subtype (Expr));
Targ_Index := First_Index (T_Typ);
while Present (Opnd_Index) loop
@@ -10923,7 +10923,7 @@ package body Checks is
if Present (Cond) then
if Do_Access then
- Cond := Guard_Access (Cond, Loc, Ck_Node);
+ Cond := Guard_Access (Cond, Loc, Expr);
end if;
Add_Check
diff --git a/gcc/ada/checks.ads b/gcc/ada/checks.ads
index 905e1120ebd..eeb77201871 100644
--- a/gcc/ada/checks.ads
+++ b/gcc/ada/checks.ads
@@ -526,12 +526,6 @@ package Checks is
-- this node is further examined depends on the setting of
-- the parameter Source_Typ, as described below.
- -- ??? Apply_Length_Check and Apply_Range_Check do not have an Expr
- -- formal
-
- -- ??? Apply_Length_Check and Apply_Range_Check have a Ck_Node formal
- -- which is undocumented, is it the same as Expr?
-
-- Target_Typ The target type on which the check is to be based. For
-- example, if we have a scalar range check, then the check
-- is that we are in range of this type.
@@ -558,7 +552,7 @@ package Checks is
-- handled by the caller.
procedure Apply_Length_Check
- (Ck_Node : Node_Id;
+ (Expr : Node_Id;
Target_Typ : Entity_Id;
Source_Typ : Entity_Id := Empty);
-- This procedure builds a sequence of declarations to do a length check
@@ -576,7 +570,7 @@ package Checks is
-- in this section.
procedure Apply_Range_Check
- (Ck_Node : Node_Id;
+ (Expr : Node_Id;
Target_Typ : Entity_Id;
Source_Typ : Entity_Id := Empty);
-- For a Node of kind N_Range, constructs a range check action that tests
@@ -628,7 +622,7 @@ package Checks is
-- call to Insert_Range_Checks procedure.
function Get_Range_Checks
- (Ck_Node : Node_Id;
+ (Expr : Node_Id;
Target_Typ : Entity_Id;
Source_Typ : Entity_Id := Empty;
Warn_Node : Node_Id := Empty) return Check_Result;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2020-06-10 3:39 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-06-10 3:39 [gcc(refs/users/guojiufu/heads/personal-branch)] [Ada] Rename parameter of routines in Checks Jiu Fu Guo
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).