-- 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
-- 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);
-- 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);
-- 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.
-- 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;
-- 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;
-- 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
-- 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)
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
-- 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;
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;
-- 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;
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;
-- 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;
-- 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));
------------------------
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;
-------------------------------------
-----------------------
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;
------------------------------
----------------------------------
procedure Apply_Selected_Length_Checks
- (Ck_Node : Node_Id;
+ (Expr : Node_Id;
Target_Typ : Entity_Id;
Source_Typ : Entity_Id;
Do_Static : Boolean)
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;
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);
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;
-- 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
-- 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;
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);
---------------------------------
procedure Apply_Selected_Range_Checks
- (Ck_Node : Node_Id;
+ (Expr : Node_Id;
Target_Typ : Entity_Id;
Source_Typ : Entity_Id;
Do_Static : Boolean)
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;
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;
-- 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
-- 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,
----------------------
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;
------------------
------------------
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
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;
----------------------------
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;
-- 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;
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;
-------------------
function Length_N_Cond
- (Expr : Node_Id;
+ (Exp : Node_Id;
Typ : Entity_Id;
Indx : Nat) return Node_Id
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;
----------------------------------
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;
-- 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;
-- 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);
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);
-- 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.
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;
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
---------------------------
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;
-- 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;
-- 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 --
-------------------------
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
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))),
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),
-------------------------
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;
------------------
function Range_N_Cond
- (Expr : Node_Id;
+ (Exp : Node_Id;
Typ : Entity_Id;
Indx : Nat) return Node_Id
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;
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;
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 ???
-- 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;
-- 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;
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;
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
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
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
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 :=
-- 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
-- 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);
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
if No (Warn_Node) then
Add_Check
(Compile_Time_Constraint_Error
- (Ck_Node,
+ (Expr,
"static value out of range of}??", T_Typ));
else
end if;
else
- Cond := Discrete_Expr_Cond (Ck_Node, T_Typ);
+ Cond := Discrete_Expr_Cond (Expr, T_Typ);
end if;
end;
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;
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
-- 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.
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;
-- 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
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
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
projects / gcc.git / commitdiff