[Ada] Remove the Has_Dynamic_Range_Check flag
2020-06-08 Eric Botcazou <ebotcazou@adacore.com> gcc/ada/ * atree.adb (New_Copy): Do not clear Has_Dynamic_Range_Check. * checks.ads (Append_Range_Checks): Remove Flag_Node parameter. (Insert_Range_Checks): Likewise and remove default value of Static_Loc parameter. * checks.adb (Append_Range_Checks): Remove Flag_Node parameter. Do not test and set Has_Dynamic_Range_Check. (Insert_Range_Checks): Likewise and remove default value of Static_Loc parameter. * csinfo.adb (CSinfo): Remove 'L' from [NEUB]_Fields pattern and do not handle Has_Dynamic_Range_Check. * exp_ch5.adb (Expand_N_Assignment_Statement): Remove argument in call to Insert_Range_Checks. * sem_ch3.adb (Analyze_Subtype_Declaration): Do not fiddle with Has_Dynamic_Range_Check. (Process_Range_Expr_In_Decl): Remove argument in calls to Insert_Range_Checks and Append_Range_Checks. * sinfo.ads (Has_Dynamic_Range_Check): Delete. (Set_Has_Dynamic_Range_Check): Likewise. * sinfo.adb (Has_Dynamic_Range_Check): Delete. (Set_Has_Dynamic_Range_Check): Likewise. * treepr.adb (Print_Node): Do not print Has_Dynamic_Range_Check.
This commit is contained in:
Eric Botcazou
Pierre-Marie de Rodat
parent
6476fc372a
commit
bbe7d67f5f
@ -1659,12 +1659,6 @@ package body Atree is
|
||||
Nodes.Table (New_Id).Rewrite_Ins := False;
|
||||
pragma Debug (New_Node_Debugging_Output (New_Id));
|
||||
|
||||
-- Clear Has_Dynamic_Range_Check since it doesn't apply anymore
|
||||
|
||||
if Nkind (Source) in N_Subexpr then
|
||||
Set_Has_Dynamic_Range_Check (New_Id, False);
|
||||
end if;
|
||||
|
||||
-- Clear Is_Overloaded since we cannot have semantic interpretations
|
||||
-- of this new node.
|
||||
|
||||
|
||||
@ -488,17 +488,13 @@ package body Checks is
|
||||
(Checks : Check_Result;
|
||||
Stmts : List_Id;
|
||||
Suppress_Typ : Entity_Id;
|
||||
Static_Sloc : Source_Ptr;
|
||||
Flag_Node : Node_Id)
|
||||
Static_Sloc : Source_Ptr)
|
||||
is
|
||||
Checks_On : constant Boolean :=
|
||||
not Index_Checks_Suppressed (Suppress_Typ)
|
||||
or else
|
||||
not Range_Checks_Suppressed (Suppress_Typ);
|
||||
|
||||
Internal_Flag_Node : constant Node_Id := Flag_Node;
|
||||
Internal_Static_Sloc : constant Source_Ptr := Static_Sloc;
|
||||
|
||||
begin
|
||||
-- For now we just return if Checks_On is false, however this should be
|
||||
-- enhanced to check for an always True value in the condition and to
|
||||
@ -514,19 +510,11 @@ package body Checks is
|
||||
if Nkind (Checks (J)) = N_Raise_Constraint_Error
|
||||
and then Present (Condition (Checks (J)))
|
||||
then
|
||||
if Has_Dynamic_Range_Check (Internal_Flag_Node) then
|
||||
pragma Assert (False);
|
||||
null;
|
||||
|
||||
else
|
||||
Append_To (Stmts, Checks (J));
|
||||
Set_Has_Dynamic_Range_Check (Internal_Flag_Node);
|
||||
end if;
|
||||
|
||||
Append_To (Stmts, Checks (J));
|
||||
else
|
||||
Append_To
|
||||
(Stmts,
|
||||
Make_Raise_Constraint_Error (Internal_Static_Sloc,
|
||||
Make_Raise_Constraint_Error (Static_Sloc,
|
||||
Reason => CE_Range_Check_Failed));
|
||||
end if;
|
||||
end loop;
|
||||
@ -3440,14 +3428,6 @@ package body Checks is
|
||||
|
||||
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 (Expr);
|
||||
end if;
|
||||
|
||||
-- The triggering condition evaluates to True, the range check
|
||||
-- can be converted into a compile time constraint check.
|
||||
|
||||
@ -7444,8 +7424,7 @@ package body Checks is
|
||||
(Checks : Check_Result;
|
||||
Node : Node_Id;
|
||||
Suppress_Typ : Entity_Id;
|
||||
Static_Sloc : Source_Ptr := No_Location;
|
||||
Flag_Node : Node_Id := Empty;
|
||||
Static_Sloc : Source_Ptr;
|
||||
Do_Before : Boolean := False)
|
||||
is
|
||||
Checks_On : constant Boolean :=
|
||||
@ -7453,9 +7432,7 @@ package body Checks is
|
||||
or else
|
||||
not Range_Checks_Suppressed (Suppress_Typ);
|
||||
|
||||
Check_Node : Node_Id;
|
||||
Internal_Flag_Node : Node_Id := Flag_Node;
|
||||
Internal_Static_Sloc : Source_Ptr := Static_Sloc;
|
||||
Check_Node : Node_Id;
|
||||
|
||||
begin
|
||||
-- For now we just return if Checks_On is false, however this should be
|
||||
@ -7466,48 +7443,25 @@ package body Checks is
|
||||
return;
|
||||
end if;
|
||||
|
||||
if Static_Sloc = No_Location then
|
||||
Internal_Static_Sloc := Sloc (Node);
|
||||
end if;
|
||||
|
||||
if No (Flag_Node) then
|
||||
Internal_Flag_Node := Node;
|
||||
end if;
|
||||
|
||||
for J in 1 .. 2 loop
|
||||
exit when No (Checks (J));
|
||||
|
||||
if Nkind (Checks (J)) = N_Raise_Constraint_Error
|
||||
and then Present (Condition (Checks (J)))
|
||||
then
|
||||
if Has_Dynamic_Range_Check (Internal_Flag_Node) then
|
||||
pragma Assert (False);
|
||||
null;
|
||||
|
||||
else
|
||||
Check_Node := Checks (J);
|
||||
Mark_Rewrite_Insertion (Check_Node);
|
||||
|
||||
if Do_Before then
|
||||
Insert_Before_And_Analyze (Node, Check_Node);
|
||||
else
|
||||
Insert_After_And_Analyze (Node, Check_Node);
|
||||
end if;
|
||||
|
||||
Set_Has_Dynamic_Range_Check (Internal_Flag_Node);
|
||||
end if;
|
||||
|
||||
Check_Node := Checks (J);
|
||||
else
|
||||
Check_Node :=
|
||||
Make_Raise_Constraint_Error (Internal_Static_Sloc,
|
||||
Make_Raise_Constraint_Error (Static_Sloc,
|
||||
Reason => CE_Range_Check_Failed);
|
||||
Mark_Rewrite_Insertion (Check_Node);
|
||||
end if;
|
||||
|
||||
if Do_Before then
|
||||
Insert_Before_And_Analyze (Node, Check_Node);
|
||||
else
|
||||
Insert_After_And_Analyze (Node, Check_Node);
|
||||
end if;
|
||||
Mark_Rewrite_Insertion (Check_Node);
|
||||
|
||||
if Do_Before then
|
||||
Insert_Before_And_Analyze (Node, Check_Node);
|
||||
else
|
||||
Insert_After_And_Analyze (Node, Check_Node);
|
||||
end if;
|
||||
end loop;
|
||||
end Insert_Range_Checks;
|
||||
|
||||
@ -637,32 +637,25 @@ package Checks is
|
||||
(Checks : Check_Result;
|
||||
Stmts : List_Id;
|
||||
Suppress_Typ : Entity_Id;
|
||||
Static_Sloc : Source_Ptr;
|
||||
Flag_Node : Node_Id);
|
||||
Static_Sloc : Source_Ptr);
|
||||
-- Called to append range checks as returned by a call to Get_Range_Checks.
|
||||
-- Stmts is a list to which either the dynamic check is appended or the
|
||||
-- raise Constraint_Error statement is appended (for static checks).
|
||||
-- Static_Sloc is the Sloc at which the raise CE node points, Flag_Node is
|
||||
-- used as the node at which to set the Has_Dynamic_Check flag. Checks_On
|
||||
-- is a boolean value that says if range and index checking is on or not.
|
||||
-- Suppress_Typ is the type to check to determine if checks are suppressed.
|
||||
-- Static_Sloc is the Sloc at which the raise CE node points.
|
||||
|
||||
procedure Insert_Range_Checks
|
||||
(Checks : Check_Result;
|
||||
Node : Node_Id;
|
||||
Suppress_Typ : Entity_Id;
|
||||
Static_Sloc : Source_Ptr := No_Location;
|
||||
Flag_Node : Node_Id := Empty;
|
||||
Do_Before : Boolean := False);
|
||||
Static_Sloc : Source_Ptr;
|
||||
Do_Before : Boolean := False);
|
||||
-- Called to insert range checks as returned by a call to Get_Range_Checks.
|
||||
-- Node is the node after which either the dynamic check is inserted or
|
||||
-- the raise Constraint_Error statement is inserted (for static checks).
|
||||
-- Suppress_Typ is the type to check to determine if checks are suppressed.
|
||||
-- Static_Sloc, if passed, is the Sloc at which the raise CE node points,
|
||||
-- otherwise Sloc (Node) is used. The Has_Dynamic_Check flag is normally
|
||||
-- set at Node. If Flag_Node is present, then this is used instead as the
|
||||
-- node at which to set the Has_Dynamic_Check flag. Normally the check is
|
||||
-- inserted after, if Do_Before is True, the check is inserted before
|
||||
-- Node.
|
||||
-- Static_Sloc is the Sloc at which the raise CE node points. Normally the
|
||||
-- checks are inserted after Node; if Do_Before is True, they are before.
|
||||
|
||||
-----------------------
|
||||
-- Expander Routines --
|
||||
|
||||
@ -89,10 +89,10 @@ procedure CSinfo is
|
||||
Flags : TV.Table (20);
|
||||
-- Maps flag numbers to letters
|
||||
|
||||
N_Fields : constant Pattern := BreakX ("JL");
|
||||
E_Fields : constant Pattern := BreakX ("5EFGHIJLOP");
|
||||
U_Fields : constant Pattern := BreakX ("1345EFGHIJKLOPQ");
|
||||
B_Fields : constant Pattern := BreakX ("12345EFGHIJKLOPQ");
|
||||
N_Fields : constant Pattern := BreakX ("J");
|
||||
E_Fields : constant Pattern := BreakX ("5EFGHIJOP");
|
||||
U_Fields : constant Pattern := BreakX ("1345EFGHIJKOPQ");
|
||||
B_Fields : constant Pattern := BreakX ("12345EFGHIJKOPQ");
|
||||
|
||||
Line : VString;
|
||||
Bad : Boolean;
|
||||
@ -215,7 +215,6 @@ begin
|
||||
Set (Special, "First_Itype", True);
|
||||
Set (Special, "Has_Aspect_Specifications", True);
|
||||
Set (Special, "Has_Dynamic_Itype", True);
|
||||
Set (Special, "Has_Dynamic_Range_Check", True);
|
||||
Set (Special, "Has_Dynamic_Length_Check", True);
|
||||
Set (Special, "Has_Private_View", True);
|
||||
Set (Special, "Is_Controlling_Actual", True);
|
||||
|
||||
@ -2465,8 +2465,7 @@ package body Exp_Ch5 is
|
||||
(C_Es,
|
||||
N,
|
||||
Target_Typ,
|
||||
Sloc (Lhs),
|
||||
Lhs);
|
||||
Sloc (Lhs));
|
||||
end;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
@ -5768,7 +5768,6 @@ package body Sem_Ch3 is
|
||||
Target_Index : Node_Id :=
|
||||
First_Index (Etype
|
||||
(Subtype_Mark (Subtype_Indication (N))));
|
||||
Has_Dyn_Chk : Boolean := Has_Dynamic_Range_Check (N);
|
||||
|
||||
begin
|
||||
while Present (Subt_Index) loop
|
||||
@ -5789,34 +5788,17 @@ package body Sem_Ch3 is
|
||||
Etype (Subt_Index),
|
||||
Defining_Identifier (N));
|
||||
|
||||
-- Reset Has_Dynamic_Range_Check on the subtype to
|
||||
-- prevent elision of the index check due to a dynamic
|
||||
-- check generated for a preceding index (needed since
|
||||
-- Insert_Range_Checks tries to avoid generating
|
||||
-- redundant checks on a given declaration).
|
||||
|
||||
Set_Has_Dynamic_Range_Check (N, False);
|
||||
|
||||
Insert_Range_Checks
|
||||
(R_Checks,
|
||||
N,
|
||||
Target_Typ,
|
||||
Sloc (Defining_Identifier (N)));
|
||||
|
||||
-- Record whether this index involved a dynamic check
|
||||
|
||||
Has_Dyn_Chk :=
|
||||
Has_Dyn_Chk or else Has_Dynamic_Range_Check (N);
|
||||
end;
|
||||
end if;
|
||||
|
||||
Next_Index (Subt_Index);
|
||||
Next_Index (Target_Index);
|
||||
end loop;
|
||||
|
||||
-- Finally, mark whether the subtype involves dynamic checks
|
||||
|
||||
Set_Has_Dynamic_Range_Check (N, Has_Dyn_Chk);
|
||||
end;
|
||||
end if;
|
||||
end if;
|
||||
@ -21233,7 +21215,6 @@ package body Sem_Ch3 is
|
||||
Insert_Node,
|
||||
Def_Id,
|
||||
Sloc (Insert_Node),
|
||||
R,
|
||||
Do_Before => True);
|
||||
end if;
|
||||
end;
|
||||
@ -21258,14 +21239,14 @@ package body Sem_Ch3 is
|
||||
if Present (Check_List) then
|
||||
Append_Range_Checks
|
||||
(R_Checks,
|
||||
Check_List, Def_Id, Sloc (Insert_Node), R);
|
||||
Check_List, Def_Id, Sloc (Insert_Node));
|
||||
end if;
|
||||
|
||||
else
|
||||
if No (Check_List) then
|
||||
Insert_Range_Checks
|
||||
(R_Checks,
|
||||
Insert_Node, Def_Id, Sloc (Insert_Node), R);
|
||||
Insert_Node, Def_Id, Sloc (Insert_Node));
|
||||
end if;
|
||||
end if;
|
||||
|
||||
|
||||
@ -1523,15 +1523,6 @@ package body Sinfo is
|
||||
return Flag10 (N);
|
||||
end Has_Dynamic_Length_Check;
|
||||
|
||||
function Has_Dynamic_Range_Check
|
||||
(N : Node_Id) return Boolean is
|
||||
begin
|
||||
pragma Assert (False
|
||||
or else NT (N).Nkind = N_Subtype_Declaration
|
||||
or else NT (N).Nkind in N_Subexpr);
|
||||
return Flag12 (N);
|
||||
end Has_Dynamic_Range_Check;
|
||||
|
||||
function Has_Init_Expression
|
||||
(N : Node_Id) return Boolean is
|
||||
begin
|
||||
@ -4997,15 +4988,6 @@ package body Sinfo is
|
||||
Set_Flag10 (N, Val);
|
||||
end Set_Has_Dynamic_Length_Check;
|
||||
|
||||
procedure Set_Has_Dynamic_Range_Check
|
||||
(N : Node_Id; Val : Boolean := True) is
|
||||
begin
|
||||
pragma Assert (False
|
||||
or else NT (N).Nkind = N_Subtype_Declaration
|
||||
or else NT (N).Nkind in N_Subexpr);
|
||||
Set_Flag12 (N, Val);
|
||||
end Set_Has_Dynamic_Range_Check;
|
||||
|
||||
procedure Set_Has_Init_Expression
|
||||
(N : Node_Id; Val : Boolean := True) is
|
||||
begin
|
||||
|
||||
@ -425,7 +425,6 @@ package Sinfo is
|
||||
-- Must_Not_Freeze (Flag8-Sem) set if must not freeze
|
||||
-- Do_Range_Check (Flag9-Sem) set if a range check needed
|
||||
-- Has_Dynamic_Length_Check (Flag10-Sem) set if length check inserted
|
||||
-- Has_Dynamic_Range_Check (Flag12-Sem) set if range check inserted
|
||||
-- Assignment_OK (Flag15-Sem) set if modification is OK
|
||||
-- Is_Controlling_Actual (Flag16-Sem) set for controlling argument
|
||||
|
||||
@ -1456,14 +1455,6 @@ package Sinfo is
|
||||
-- action which has been inserted at the flagged node. This is used to
|
||||
-- avoid the generation of duplicate checks.
|
||||
|
||||
-- Has_Dynamic_Range_Check (Flag12-Sem)
|
||||
-- This flag is present in N_Subtype_Declaration nodes and on all
|
||||
-- expression nodes. It is set to indicate that one of the routines in
|
||||
-- unit Checks has generated a range check action which has been inserted
|
||||
-- at the flagged node. This is used to avoid the generation of duplicate
|
||||
-- checks. Why does this occur on N_Subtype_Declaration nodes, what does
|
||||
-- it mean in that context???
|
||||
|
||||
-- Has_Local_Raise (Flag8-Sem)
|
||||
-- Present in exception handler nodes. Set if the handler can be entered
|
||||
-- via a local raise that gets transformed to a goto statement. This will
|
||||
@ -2866,7 +2857,6 @@ package Sinfo is
|
||||
-- Subtype_Indication (Node5)
|
||||
-- Generic_Parent_Type (Node4-Sem) (set for an actual derived type).
|
||||
-- Exception_Junk (Flag8-Sem)
|
||||
-- Has_Dynamic_Range_Check (Flag12-Sem)
|
||||
|
||||
-------------------------------
|
||||
-- 3.2.2 Subtype Indication --
|
||||
@ -9588,9 +9578,6 @@ package Sinfo is
|
||||
function Has_Dynamic_Length_Check
|
||||
(N : Node_Id) return Boolean; -- Flag10
|
||||
|
||||
function Has_Dynamic_Range_Check
|
||||
(N : Node_Id) return Boolean; -- Flag12
|
||||
|
||||
function Has_Init_Expression
|
||||
(N : Node_Id) return Boolean; -- Flag14
|
||||
|
||||
@ -10694,9 +10681,6 @@ package Sinfo is
|
||||
procedure Set_Has_Dynamic_Length_Check
|
||||
(N : Node_Id; Val : Boolean := True); -- Flag10
|
||||
|
||||
procedure Set_Has_Dynamic_Range_Check
|
||||
(N : Node_Id; Val : Boolean := True); -- Flag12
|
||||
|
||||
procedure Set_Has_Init_Expression
|
||||
(N : Node_Id; Val : Boolean := True); -- Flag14
|
||||
|
||||
@ -13347,7 +13331,6 @@ package Sinfo is
|
||||
pragma Inline (Has_Created_Identifier);
|
||||
pragma Inline (Has_Dereference_Action);
|
||||
pragma Inline (Has_Dynamic_Length_Check);
|
||||
pragma Inline (Has_Dynamic_Range_Check);
|
||||
pragma Inline (Has_Init_Expression);
|
||||
pragma Inline (Has_Local_Raise);
|
||||
pragma Inline (Has_Self_Reference);
|
||||
@ -13712,7 +13695,6 @@ package Sinfo is
|
||||
pragma Inline (Set_Has_Created_Identifier);
|
||||
pragma Inline (Set_Has_Dereference_Action);
|
||||
pragma Inline (Set_Has_Dynamic_Length_Check);
|
||||
pragma Inline (Set_Has_Dynamic_Range_Check);
|
||||
pragma Inline (Set_Has_Init_Expression);
|
||||
pragma Inline (Set_Has_Local_Raise);
|
||||
pragma Inline (Set_Has_No_Elaboration_Code);
|
||||
|
||||
@ -1131,12 +1131,6 @@ package body Treepr is
|
||||
Print_Eol;
|
||||
end if;
|
||||
|
||||
if Has_Dynamic_Range_Check (N) then
|
||||
Print_Str (Prefix_Str_Char);
|
||||
Print_Str ("Has_Dynamic_Range_Check = True");
|
||||
Print_Eol;
|
||||
end if;
|
||||
|
||||
if Is_Controlling_Actual (N) then
|
||||
Print_Str (Prefix_Str_Char);
|
||||
Print_Str ("Is_Controlling_Actual = True");
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user