From 6c8e70fe86da1b52160aa380f30cbb1bf644c407 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Thu, 30 Jan 2020 13:23:31 +0100 Subject: [PATCH] [Ada] Rename parameter of routines in Checks 2020-06-05 Eric Botcazou 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. --- 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; -- 2.30.2